使用 VBA 将标题行插入多个 CSV 文件

Question

我有一个宏，可以将一个巨大的 CSV 文件分成多个块，例如50,000 行，但只有第一个拆分文件包含标题。我需要修改代码以将标题包含在每个单独的文件中，或者在脚本末尾添加一段逻辑，它将遍历文件夹中的所有文件并添加标题记录（文件除外1).

这是当前脚本：

Sub SplitCSVFile()
'Splits a text or csv file into smaller files with a user defined number (max) of lines or rows. The new files get the original file name + a number (1, 2, 3 etc.).

Dim sFile As String  'Name of the original file
Dim sText As String  'The file text
Dim lStep As Long    'Max number of lines in the new files
Dim vX, vY           'Variant arrays. vX = input, vY = output
Dim iFile As Integer 'File number from Windows
Dim lCount As Long   'Counter
Dim lIncr As Long    'Number for file name
Dim lMax As Long     'Upper limit for loop
Dim lNb As Long      'Counter
Dim lSoFar As Long   'How far did we get?

On Error GoTo ErrorHandle

'Select a file
sFile = Application.GetOpenFilename()

'If the user cancelled
If sFile = "False" Then Exit Sub

'Ask the user for max number of lines per file.
lStep = Application.InputBox("Max number of lines/rows?", Type:=1)

'Arrays have zero as LBound, so we subtract 1
lStep = lStep - 1

'Read the file text to sText
sText = _
CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile).ReadAll

'Put the text into the array vX. Carriage return–linefeed combination will add a new row to the array.
 vX = Split(sText, vbCrLf)

'Free memory
sText = ""

'Start a loop that will run until all rows in the array have been read and saved into new files. The variable lSoFar keeps track of how far we are in vX.
Do While lSoFar < UBound(vX)
   'If the number of rows minus lSoFar is bigger than max number of rows, the array vY is dimensioned to max number of rows.
   If UBound(vX) - lSoFar >= lStep Then
      ReDim vY(lStep)
      'lMax is set = last rownumber to be copied to vY.
      lMax = lStep + lSoFar
   Else
      'Else we dimension vY to the number of rows left.
      ReDim vY(UBound(vX) - lSoFar)
      'Last row to copy is last row in vX
      lMax = UBound(vX)
   End If

   lNb = 0
   'Now we copy the rows from vX to vY
   For lCount = lSoFar To lMax
      vY(lNb) = vX(lCount)
      lNb = lNb + 1
   Next

   'lSoFar keeps track of how far we got in vX
   lSoFar = lCount

   'Get a free file number
   iFile = FreeFile

   'Increment the number for the new file name
   lIncr = lIncr + 1

   'Save vY as a CSV file
   'Open sFile & "-" & lIncr & ".csv" For Output As #iFile
    Open Replace(sFile, ".csv", "") & "_" & lIncr & ".csv" For Output As #iFile
      'The Join function makes a text string from the array elements.
      Print #iFile, Join$(vY, vbCrLf)
   Close #iFile
Loop

Erase vX
Erase vY

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure SplitTextFile"
End Sub

Answer 1

只要换行

Print #iFile, Join$(vY, vbCrLf)

与

Print #iFile, IIf(lIncr = 0, "", vX(0) & vbCrLf) & Join$(vY, vbCrLf)

Answer 2

在 Print 语句中使用 lIncr = 0 值将为您拆分的第一个 csv 生成一个辅助标头。

由于在调用 Print 语句时 lIncr 值已经 = 1，并且标题是为初始 csv 打印的第一行，因此 IIF 检查失败并包含辅助标题 vX(0)。

IIF 检查用于填充所需的每个附加 csv 的标头。

正确的打印语句是……

打印#iFile, IIf(lIncr = 1, "", vX(0) & vbCrLf) & Join$(vY, vbCrLf)