Excel 2010 - Einzelne XSLM in mehrere CSV-Dateien exportieren

Question

In Ordnung, also, im Grunde habe ich eine XSLM-Datei mit etwa ~ 40.000 Zeilen. Ich muss diese Zeilen in ein benutzerdefiniertes CSV-Format exportieren -^abgegrenzt und ~ markiert die Grenzen jeder Zelle. Sobald sie exportiert wurden, werden sie von einer Joomla-Import-App eingelesen und in die Datenbank verarbeitet. Ich habe ein gutes Makro-Skript gefunden, das genau das tut und es so optimiert, dass es die korrekten Trennzeichen verwendet.

Sub CSVFile() 

    Dim SrcRg As Range 
    Dim CurrRow As Range 
    Dim CurrCell As Range 
    Dim CurrTextStr As String 
    Dim ListSep As String 
    Dim FName As Variant 
    FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv") 

    'ListSep = Application.International(xlListSeparator) 
    ListSep = "^" ' Use^as field separator. 
    If Selection.Cells.Count > 1 Then 
     Set SrcRg = Selection 
    Else 
     Set SrcRg = ActiveSheet.UsedRange 
    End If 

    Open FName For Output As #1 
    For Each CurrRow In SrcRg.Rows 
     CurrTextStr = ìî 
     For Each CurrCell In CurrRow.Cells 
      CurrTextStr = CurrTextStr & "~" & CurrCell.Value & "~" & ListSep 
     Next 
     While Right(CurrTextStr, 1) = ListSep 
      CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1) 
     Wend 

     Print #1, CurrTextStr 
    Next 
    Close #1 
End Sub 

aber was habe ich gefunden habe ist, dass die erzeugten CSVs sind einfach zu groß, mit der verfügbaren Skriptausführungszeit behandelt werden. Ich kann die Dateien manuell auf etwa 5000 Zeilen pro Stück aufteilen und es geht gut genug. Was ich tun möchte ist, das obige Skript wie folgt anzupassen:

1. Speichert die Kopfzeile, die in jede Datei eingefügt werden soll.
2. Fragt den Benutzer, wie viele Zeilen pro Datei ausgegeben werden sollen.
3. Anfügen -pt # an den ausgewählten Speichern als Dateinamen.
4. Verarbeitet die Excel-Datei in so viele "Chunk" -Csv-Dateien wie erforderlich.

Zum Beispiel, wenn meine Dateinamen ausgegeben werden, war die Datei Pause Nummer 5000 und die Excel-Datei hatte 14000 Zeilen, ich mit Ausgabe-pt1.csv würde am Ende, Ausgabe-pt2.csv und Ausgabe-pt3.csv.

Wenn ich es nur tun würde, würde ich die Dateien immer noch manuell brechen, aber wenn alles gesagt und getan ist, muss ich diese Dateien an den Client übergeben, der das Projekt in Auftrag gibt, je einfacher, desto besser.

Sehr geschätzt für irgendwelche Ideen.

Answer 1

So etwas könnte für Sie arbeiten. Ungeprüfte, sondern kompiliert ...

Sub CSVFile() 

    Const MAX_ROWS As Long = 5000 
    Dim SrcRg As Range 
    Dim CurrRow As Range 
    Dim CurrCell As Range 
    Dim CurrTextStr As String 
    Dim ListSep As String 
    Dim FName As Variant, newFName As String 
    Dim TextHeader As String, lRow As Long, lFile As Long 

    FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv") 

    'ListSep = Application.International(xlListSeparator) 
    ListSep = "^" ' Use^as field separator. 
    If Selection.Cells.Count > 1 Then 
     Set SrcRg = Selection 
    Else 
     Set SrcRg = ActiveSheet.UsedRange 
    End If 

    lRow = 0 
    lFile = 1 

    newFName = Replace(FName, ".csv", "_pt" & lFile & ".csv") 
    Open newFName For Output As #1 

    For Each CurrRow In SrcRg.Rows 
     lRow = lRow + 1 
     CurrTextStr = "" 
     For Each CurrCell In CurrRow.Cells 
      CurrTextStr = CurrTextStr & "~" & CurrCell.Value & "~" & ListSep 
     Next 
     While Right(CurrTextStr, 1) = ListSep 
      CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1) 
     Wend 

     If lRow = 1 Then TextHeader = CurrTextStr 
     Print #1, CurrTextStr 

     If lRow > MAX_ROWS Then 
      Close #1 
      lFile = lFile + 1 
      newFName = Replace(FName, ".csv", "_pt" & lFile & ".csv") 
      Open newFName For Output As #1 
      Print #1, TextHeader 
      lRow = 0 
     End If 

    Next 

    Close #1 
End Sub 

Answer 2

Also, mit Tim Hilfe, hier ist die letzte Version, die ein Argument auf der maximalen Anzahl der Zeilen pro Datei und gibt an, wie viele Sub-Dateien nach Bedarf übernimmt.

Sub CSVFile() 

    Dim MaxRows As Long 
    Dim SrcRg As Range 
    Dim CurrRow As Range 
    Dim CurrCell As Range 
    Dim CurrTextStr As String 
    Dim ListSep As String 
    Dim FName As Variant, newFName As String 
    Dim TextHeader As String, lRow As Long, lFile As Long 

    FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv") 
    MaxRows = Application.InputBox(Prompt:="Enter maximum number of rows per file.", _ 
     Default:=5000, Type:=1) 

    'ListSep = Application.International(xlListSeparator) 
    ListSep = "^" ' Use^as field separator. 
    If Selection.Cells.Count > 1 Then 
     Set SrcRg = Selection 
    Else 
     Set SrcRg = ActiveSheet.UsedRange 
    End If 

    lRow = 0 
    lFile = 1 

    newFName = Replace(FName, ".csv", "-pt" & lFile & ".csv") 
    Open newFName For Output As #1 

    For Each CurrRow In SrcRg.Rows 
     lRow = lRow + 1 
     CurrTextStr = "" 
     For Each CurrCell In CurrRow.Cells 
      CurrTextStr = CurrTextStr & "~" & CurrCell.Value & "~" & ListSep 
     Next 
     While Right(CurrTextStr, 1) = ListSep 
      CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1) 
     Wend 

     If lRow = 1 And lFile = 1 Then TextHeader = CurrTextStr 'Capture the header row 

     Print #1, CurrTextStr 

     If lRow > MaxRows Then 
      Close #1 
      lFile = lFile + 1 
      newFName = Replace(FName, ".csv", "-pt" & lFile & ".csv") 
      Open newFName For Output As #1 
      Print #1, TextHeader 
      lRow = 0 
     End If 

    Next 

    Close #1 
End Sub 

habe ich nur noch eine Anforderung für eine Benutzereingabe, die max Zeilen zu erhalten, und zwickte es auch, damit es nicht die Kopfzeile mit jeder neuen Datei aktualisiert wurde. Danke nochmal für die Hilfe.