Excel 2010 - 複数のCSVファイルに1つのXSLMをエクスポート

Question

さて、基本的に、約40k行を含むXSLMファイルがあります。私はカスタマイズされたCSV形式にこれらの行をエクスポートする必要があります - 各セルの境界を区切って〜印を付ける。一度エクスポートされると、Joomlaのインポーターアプリによって読み込まれ、データベースに処理されます。私はちょうど良い区切り文字を使用するためにそれを微調整した良いマクロスクリプトを見つけました。

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 

しかし、私が見つけたのは、生成されたCSVが大きすぎるため、利用可能なスクリプト実行時間で処理できないということです。私は、ファイルを手動で約5000行に分割することができ、それだけで十分です。私がしたいのは、上記のスクリプトを次のように調整することです：

1. 各ファイルに挿入するヘッダ行を格納します。
2. ファイルごとに出力する行数をユーザーに要求します。
3. ファイル名として選択した保存に-pt＃を追加します。
4. Excelファイルを必要なだけ多くの 'チャンク' csvファイルに処理します。たとえば、

私のファイル名が出力された場合は、ファイルのブレーク数は5000で、Excelファイルが14000行を持っていた、私は、出力pt1.csv、出力pt2.csvで終わるだろう、とoutput-pt3.csv。

もし私がそれをやっていたのであれば、私は手作業でファイルを破壊し続けていましたが、すべてが完了したら、プロジェクトを委託するクライアントにこれらのファイルを渡す必要があります。

多くのアイデアに感謝します。

Answer 1

何かがあなたのために働くかもしれません。未テストが、コンパイル...

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

ので、ティムの助けを借りて、ここで必要な数のサブファイルへのファイルあたりの行、および出力の最大数の引数を受け取り、最終的なバージョンがあります。

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 

私は最大行数を取得するためのユーザ入力の要求を添加し、そしてまた、それは、それぞれの新しいファイルにヘッダ行を更新しなかったので、それを微調整。助けてくれてありがとう。