Regels voor een bepaalde datum uit veel csv's knippen

Status
Niet open voor verdere reacties.
W

Woffels

Gebruiker
Lid geworden
8 jan 2006
Berichten
249
Ik heb een map met >100 csv's die allemaal dezelfde indeling hebben. In de eerste kolom van elke csv staat altijd de datum en tijd. Deze csv's bevatten nog data uit 2021 die ik er vanaf wil knippen voor het maken van het jaaroverzicht van 2022.
Nu wil ik uit alle csv's, ongeachte het aantal, in die map (bv: C:\csv), alle dataregels ouder dan 31-12-2021 12:00 en jonger dan 01-01-2023 12:01 afknippen en weer opslaan met 2022 als toevoeging aan de bestaande naam. De originele csv heeft een willekeurige naam.csv en moet behouden blijven.
De eerste rij, waar de headers staan, wil ik ook behouden.

In de voorbeeldbestanden:
- all.csv = het bronbestand
- 2022_all.csv = beoogde doelbestand
Het bronbestand heeft in het voorbeeld maar twee kolommen, maar heeft er in het echt veel meer (23), maar die heb ik er ivm grootte van het te uploaden bestand er vanaf geknipt. Sommige bronbestanden zijn momenteel >100Mb.
 

Bijlagen

  • all.zip
    1,8 MB · Weergaven: 14
  • 2022_all.zip
    1,7 MB · Weergaven: 12
Ziezo:

Code: 
Sub M_snb()
  With CreateObject("scripting.filesystemobject")
   .createtextfile("J:\temp\2022_all.csv").write Join(Filter(Split(.opentextfile("J:\temp\all.csv").readall, vbCrLf), "-2022"), vbCrLf)
  End With
End Sub
 
Bedankt voor de snelle reactie, werkt deels, maar het is niet helemaal wat ik voor ogen heb.

- Het gaat om alle csv's die in een map staan, ongeacht het aantal en bestandsnaam.
- Ik wil de data van 31-12-2021 12:00 tot 01-01-2023 12:01 in de nieuwe csv's hebben met 2022_ als toevoeging vooraan in de bestandsnaam.
- Ook moeten de headers in de csv behouden blijven. In het voorbeeld bestand zijn het slechts 2 kolommen, maar de csv's die ik wil bewerken kunnen dat er veel meer zijn, maar heb die ivm de maximaal toegestane upload grootte van helpmij er even vanaf geknipt.
 
Hallo,

Je krijgt 95% procent, maar wil 110% hebben. Wat leer je daar nu weer van ?
Dit is een forum, geen gratis softwareleverancier.
Voor betaalde opdrachten ben ik beschikbaar; geef maar een gil.
 
Ik had al een zo'n donkerbruin vermoeden dat je zo zou reageren. Ik vraag absoluut geen totaal oplossing en krijg nauwelijks 50%, ik vraag een oplossing waar ik verder mee kan en dat kan ik met de gegeven oplossing niet.
Maar misschien zijn er wel andere mensen die me wel wat verder kunnen helpen.
 
Dit gaat gegarandeerd lang duren, maarja ik neem aan dat het eenmalig is. Je zou het eens kunnen testen in een testmap.

Code: 
Sub jec()
 Dim fl, r
 Application.ScreenUpdating = False
 For Each fl In CreateObject("scripting.filesystemobject").getfolder("C:\csv\").Files
   With Workbooks.Open(fl, local:=True).Sheets(1).Cells(1).CurrentRegion
      Set r = .Offset(, .Columns.Count + 1).Resize(2, 1)
      r(2).Formula = "=(a2<44561.5)+(a2>44927.5)"
      .AdvancedFilter 1, r
      .Offset(1).EntireRow.Delete
      .Parent.ShowAllData
      r.ClearContents
      .Parent.Parent.SaveAs Replace(fl, fl.Name, "2022_" & fl.Name), 6, , , , , , , , , , 1
      .Parent.Parent.Close 0
   End With
 Next
End Sub
 
Laatst bewerkt:
Deze kun je ook proberen

Code: 
Sub jec()
  Dim ar, fl, a, sp, sq, i As Long, x As Long
  With CreateObject("scripting.filesystemobject")
    For Each fl In .getfolder("C:\csv\").Files
       a = Split(.opentextfile(fl).readall, vbCrLf)
       ReDim ar(UBound(a))
       For i = 0 To UBound(a) - 1
          sp = Split(a(i), ";")
          If i > 0 Then sq = CDbl(CDate(sp(0)))
          If ((sq >= 44561.5) * (sq <= 44927.5)) + (i = 0) Then
            ar(x) = sp(0) & ";" & sp(1)
            x = x + 1
          End If
       Next
       x = 0
     .createtextfile(Replace(fl, fl.Name, "2022_" & fl.Name)).write Join(ar, vbCrLf)
    Next
  End With
End Sub
 
Laatst bewerkt:
@jec

Werkt perfect, bedankt. Je eerste methode doet 28 sec over 6 bestanden van 13Mb en de tweede methode 18 sec, dus dat is behoorlijke winst.
Maar ga ik nu testen met bestanden met meerdere kolommen, zoals ik in mijn eerste post schreef, dan pakt ie alleen de datum kolom en de tweede kolom waar meetdata in staat en niet de rest van de kolommen.
Ik ben hem al aan het debuggen, maar het lukt me niet om het met meerdere kolommen voor elkaar te krijgen.
Als voorbeeld bestand een voorbeeld met meerdere kolommen.
 

Bijlagen

  • all.zip
    1,9 MB · Weergaven: 10
Mooi dat het werkt! Probeer dit eens

Code: 
Sub jec()
  Dim ar, fl, a, sp, sq, i As Long, j As Long, x As Long
  With CreateObject("scripting.filesystemobject")
    For Each fl In .getfolder("C:\csv\").Files
       a = Split(.opentextfile(fl).readall, vbCrLf)
       ReDim ar(UBound(a))
       For i = 0 To UBound(a) - 1
          sp = Split(a(i), ";")
          If i > 0 Then sq = CDbl(CDate(sp(0)))
          If ((sq >= 44561.5) * (sq <= 44927.5)) + (i = 0) Then
            For j = 0 To UBound(sp)
               ar(x) = ar(x) & sp(j) & ";"
            Next
            x = x + 1
          End If
       Next
       x = 0
     .createtextfile(Replace(fl, fl.Name, "2022_" & fl.Name)).write Join(ar, vbCrLf)
    Next
  End With
End Sub
 
Ach, op een één of andere manier heb jij toch altijd gelijk en het laatste woord. Ik probeer altijd netjes en beleefd te zijn en iedereen is hier vrij om te reageren op vragen. Ik snap ook helemaal niet waarom je reageerde zoals je vanmiddag deed:
Dit is een forum, geen gratis softwareleverancier.
Voor betaalde opdrachten ben ik beschikbaar; geef maar een gil.
Klik om te vergroten...
Je wekt hiermee de indruk dat ik hier probeer te vissen naar gratis advies om er beter van te worden terwijl je zelf dondersgoed weet met wat voor een project ik als vrijwilliger bezig ben in mijn vrije tijd. Het is geweldig dat ik hier op dit forum bijna altijd en snel geholpen wordt, er van leer en met de adviezen verder kan met mijn project.
Erg jammer dat je dan zo reageert. Maar als je je er zo aan stoort zou ik voor willen stellen niet meer op mijn berichten te reageren.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan