Meerdere CSV bestanden genereren uit 1 Excel sheet

BarryT · 21 okt 2021

Goedemiddag,

Ik vroeg mij af of het mogelijk is om vanuit een Excel tabel, meerdere csv bestanden te genereren op basis van de inhoud van een bepaalde kolom, met als doel om een snijmachine aan te sturen.

Er wordt vanuit een software pakket een excel bestand gegenereerd waar per project een lijst wordt gegenereerd van kanaal lengtes die gesneden moeten worden.
Het bestand wordt echter genereerd met alle vloeren van alle bouwnummers in één bestand.
De snijmachine moet gevoed worden met een csv per bouwnummer.

De bedoeling is daarom om alle lengtes die toegekend zijn aan een bepaald bouwnummer (in kolom C) EN een bepaalde vloer (kolom B) op te slaan als een csv bestand.
En dat vervolgens voor alle bouwnummers en vloeren in het Excel bestand.

Om e.e.a. te verduidelijken heb ik een voorbeeld bestand toegevoegd.
Edit: nieuw voorbeeld bestand toegevoegd.

Hopelijk kan iemand mij verder helpen, of aangeven dat het gewoon niet mogelijk is.

edmoor · 21 okt 2021

Dat is met VBA wel mogelijk als je daar geen bezwaar tegen hebt.

BarryT · 21 okt 2021

Bedankt voor je reactie Edmoor.
VBA code is uiteraard geen probleem.
Als het op die manier mogelijk is, dan heel graag! :thumb:

edmoor · 21 okt 2021

Prima.
Zal ik er vanavond naar kijken.

BarryT · 21 okt 2021

edmoor zei:
Prima.
Zal ik er vanavond naar kijken.

Top! Wordt alvast enorm gewaardeerd.

snb · 21 okt 2021

bijv.

Code:

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion
  
  n = 0
  c00 = ThisWorkbook.Path & "\snb_00#.csv"
  
  With CreateObject("scripting.filesystemobject")
    For j = 2 To UBound(sn)
      If sn(j, 3) = n Then
        c01 = c01 & vbLf & Join(Application.Index(sn, j), ";")
      Else
        If c01 <> "" Then .createtextfile(c02).write c01
        n = sn(j, 3)
        c02 = Replace(c00, "#", n)
        c01 = Join(Application.Index(sn, 1), ";") & vbLf & Join(Application.Index(sn, j), ";")
      End If
    Next
    If c01 <> "" Then .createtextfile(c02).write c01
  End With
End Sub

BarryT · 22 okt 2021

Hallo snb,

Allereerst bedankt voor je reactie en bijdrage!
Zou jij kunnen aangeven wat de code precies doet?

Hij neemt nu namelijk niet alle regels mee over in de csv bestanden die bij eenzelfde bouwnummer horen.

Ik heb bijvoorbeeld 20 regels die behoren tot een bouwnummer, waarvan er nu 4 worden overgenomen naar het csv bestand met de code uit jouw oplossing.
Dit zijn de 4 laatste regels die tot dit bouwnummer behoren.

Wellicht handig om te vermelden is dat de 4 regels die nu overgenomen worden in het csv bestand, wel in dezelfde tabel staan, maar wel ergens onderin de currentregion.
Het komt dus voor dat de regels niet 'op volgorde' staan, maar alle regels behorend tot eenzelfde bouwnummer dienen in het csv bestand te komen.

En mocht het mogelijk zijn, zou ik graag willen dat de regels waarbij de lengte tussen de 2990 en 3000 valt, NIET worden meegenomen in het csv bestand per bouwnummer.

Edit:
Zojuist nog even wat getest en de oplossing van snb werkt wel als ik in de code eerst regels opneem om te sorteren op bouwnummer en positienummer.
Eigenlijk wil ik dat niet, maar als het niet anders kan, dan is het niet anders..

Dit heb ik zo aangepast:

Code:

Sub M_snb2()
  
  sn = Blad1.Cells(1).CurrentRegion
  
  n = 0
  c00 = ThisWorkbook.Path & "\test_00#.csv"
   
    ActiveWorkbook.ActiveSheet.AutoFilter.sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.AutoFilter.sort.SortFields.Add2 Key:=Range _
        ("C2:C10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.ActiveSheet.AutoFilter.sort.SortFields.Add2 Key:=Range _
        ("D2:D10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.ActiveSheet.AutoFilter.sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
  With CreateObject("scripting.filesystemobject")
    For j = 2 To UBound(sn)
      If sn(j, 3) = n Then
        c01 = c01 & vbLf & Join(Application.Index(sn, j), ";")
      Else
        If c01 <> "" Then .createtextfile(c02).write c01
        n = sn(j, 3)
        c02 = Replace(c00, "#", n)
        c01 = Join(Application.Index(sn, 1), ";") & vbLf & Join(Application.Index(sn, j), ";")
        End If
      
    Next
    If c01 <> "" Then .createtextfile(c02).write c01
    
  End With
End Sub

Is het ook mogelijk om een apart .csv bestand te maken per bouwnummer en per vloer?
Waarbij de regels worden overgeslagen indien de lengte gelijk is aan 3000?

Heb een nieuw voorbeeld bestand toegevoegd waarbij ik heb aangegeven wat ik precies bedoel, hopelijk helpt dit!

Alvast bedankt voor jullie reacties :thumb:

snb · 22 okt 2021

Verdiep je eens in de advancedfilter van Excel.
Sorteren vooraf is in dit geval niet nodig.

Code:

Sub M_snb()
   If Sheets.Count = 1 Then Sheets.Add , Sheets(Sheets.Count)
   Blad1.Columns(3).AdvancedFilter 2, , Blad1.Cells(1, 30), True
   Blad1.Columns(2).AdvancedFilter 2, , Blad1.Cells(1, 31), True
   sn = Blad1.Cells(1, 30).CurrentRegion
   
   Blad1.Cells(1, 30).CurrentRegion.Offset(1).ClearContents
   
   For j = 2 To UBound(sn)
     For jj = 2 To UBound(sn)
       If sn(j, 1) <> "" And sn(jj, 2) <> "" Then
        Blad1.Cells(j, 30).Resize(, 2) = Array(sn(j, 1), sn(jj, 2))
        Sheets(2).UsedRange.ClearContents
        Blad1.Cells(1).CurrentRegion.AdvancedFilter 2, Blad1.Cells(1, 30).CurrentRegion, Sheets(2).Cells(1)
        Sheets(2).Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Blad1.Cells(1, 22) & sn(j, 1) & "_" & Blad1.Cells(1, 3) & sn(jj, 2) & ".csv", 23
        ActiveWorkbook.Close 0
       End If
     Next
   Next
End Sub

BarryT · 22 okt 2021

Wederom bedankt voor je oplossing snb!

Het is nog net niet helemaal wat ik zoek, omdat er met deze code van ieder bouwnummer, en elke vloer die in de lijst voorkomt (ongeacht of het bij dit bouwnummer van toepassing is) een .csv bestand wordt aangemaakt.
Wanneer bijvoorbeeld bij bouwnummer 1 een 1e verd.vloer aanwezig is het bestand, maar geen 2e verd.vloer, wordt er met deze code een leeg .csv bestand (wel de header uiteraard) aangemaakt met bwnr 1 - 2e verd.vloer wanneer de 2e verd. vloer wel voorkomt bij een ander bouwnummer.

Is dat nog op te lossen dat hier dan geen csv bestand voor wordt aangemaakt?

Ik zag overigens dat met deze code de csv bestanden worden aangemaakt met een "," als divider in plaats van een ";".
Dit heb ik op de volgende manier opgelost na wat speurwerk:

Code:

        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Blad1.Cells(1, 22) & sn(j, 1) & "_" & Blad1.Cells(1, 3) & sn(jj, 2) & ".csv", FileFormat:=xlCSV, CreateBackup:=False, local:=True

snb · 22 okt 2021

Je geeft zelf de oplossing al: als het resultaat van de filtering alleen bestaat uit de veldnamen, dan hoeft het bestand niet gekopieerd te worden.
Probeer dit zelf te vertalen in een regel VBA.

Als je zicht hebt op de werking van advancedfilter weet je ook hoe je uit het resultaat de regels met de waarde 3000 moet verwijderen/uitsluiten.

BarryT · 24 okt 2021

Heb het op deze manier opgelost:

Code:

        If ActiveWorkbook.ActiveSheet.Range("A1").CurrentRegion.Rows.Count <> 1 Then
                
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & strProject & " - " & "bwnr " & Blad1.Cells(1, 22) & sn(j, 1) & "_" & sn(jj, 2) & ".csv", FileFormat:=xlCSV, CreateBackup:=False, local:=True
            ActiveWorkbook.Close 0
        
        Else
            ActiveWorkbook.Close savechanges:=False
        
        End If

@snb enorm bedankt voor je hulp!

snb · 25 okt 2021

Niet slecht, maar die test kan ook al op het filterresultaat plaatsvinden:

Code:

if sheets(2).cells(1).currentregion.rows.count>1 then
   Sheets(2).Copy
   ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Blad1.Cells(1, 22) & sn(j, 1) & "_" & Blad1.Cells(1, 3) & sn(jj, 2) & ".csv", 23
   ActiveWorkbook.Close 0
end if

BarryT · 25 okt 2021

Ook een mooie oplossing @snb.

Er zat overigens een foutje in jou oplossing, die heb ik na wat testen opgelost.

Code:

Sub M_snb()
   If Sheets.Count = 1 Then Sheets.Add , Sheets(Sheets.Count)
   Blad1.Columns(3).AdvancedFilter 2, , Blad1.Cells(1, 30), True
   Blad1.Columns(2).AdvancedFilter 2, , Blad1.Cells(1, 31), True
   sn = Blad1.Cells(1, 30).CurrentRegion
   
   Blad1.Cells(1, 30).CurrentRegion.Offset(1).ClearContents
   
   For j = 2 To UBound(sn)
     For jj = 2 To UBound(sn)
       If sn(j, 1) <> "" And sn(jj, 2) <> "" Then
        Blad1.Cells(j, 30).Resize(, 2) = Array(sn(j, 1), sn(jj, 2))
        Sheets(2).UsedRange.ClearContents
        Blad1.Cells(1).CurrentRegion.AdvancedFilter 2, Blad1.Cells(1, 30).CurrentRegion, Sheets(2).Cells(1)
        Sheets(2).Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Blad1.Cells(1, 22) & sn(j, 1) & "_" & Blad1.Cells(1, 3) & sn(jj, 2) & ".csv", 23
        ActiveWorkbook.Close 0
       End If
     Next
   Next
End Sub

in deze regel:

Code:

        Blad1.Cells(j, 30).Resize(, 2) = Array(sn(j, 1), sn(jj, 2))

Dit moet zijn:

Code:

        Blad1.Cells(2, 30).Resize(, 2) = Array(sn(j, 1), sn(jj, 2))

Anders komen er alleen maar criteria bij, en krijg je op een gegeven moment ook de regels uit de voorgaande resultaten van de advancedfilter mee in de csv bestanden.

Nogmaals bedankt voor je hulp snb, heeft me enorm op weg geholpen! :thumb:

Meerdere CSV bestanden genereren uit 1 Excel sheet

BarryT

Gebruiker

Bijlagen

edmoor

Inventaris

BarryT

Gebruiker

edmoor

Inventaris

BarryT

Gebruiker

snb

Verenigingslid

BarryT

Gebruiker

Bijlagen

snb

Verenigingslid

BarryT

Gebruiker

snb

Verenigingslid

BarryT

Gebruiker

snb

Verenigingslid

BarryT

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy