我编写了以下代码将平面文件拆分为较小的文件,每个文件最多包含 1M 条记录。
目前,代码运行良好,但将一个 100 MB 文件(包含大约 5M 条记录)拆分为 5 个文件,每个文件有 1M 条记录大约需要 2 分钟。
您能否建议一种使此代码运行得更快的方法,因为我需要拆分大于 2 GB 的文件。
提前非常感谢。
Private Sub cmb_split_Click()
'Splits a text or csv fileinto smaller files with a user defined number(max) of lines or rows. The new files get the original file name + a number (1, 2, 3etc.).
'declare variables
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 sExtn As String 'Chosen extension of split file
Dim resp As Integer 'capture user response
Dim extn As String 'file extesion of split files
Dim vX, vY 'Variant arrays. vX = input, vY =output
Dim iFile As Integer 'Filenumber 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?
'max record count per file after splitting original file
lStep = 1000000
'delimiter for the split files
extn = ".csv"
On Error GoTo ErrorHandle
'Select a file
sFile =Application.GetOpenFilename()
'If the user canceled
If sFile = "False" Then
Exit Sub
'Our arrays have zero asLBound, 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. Linefeed chars (new line) will add a new row to the array.
vX = Split(sText, vbLf)
'Free memory
sText = ""
'Now we 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 + 1)
'lMax is set = lastrownumber to be copied to vY.
lMax = lStep + lSoFar
Else
'Else we dimension vY to the number of rows left
ReDim vY(UBound(vX)- lSoFar + 1)
'Last row to copy is last row in vX
lMax = UBound(vX)
End If
lNb = 0
'For the first file, copy the desired rows as is since header will be copied automatically
If lSoFar = 0 Then
'Now we copy the rowsfrom vX to vY
For lCount =lSoFar To lMax + 1
vY(lNb) =vX(lCount)
lNb = lNb + 1
Next
Else
'For subsequent split files, fill the first row as the header row explicitly
vY(0) = vX(0)
'Now we copy the rows from vX to vY from 2nd row onwards
For lCount =lSoFar To lMax
vY(lNb + 1) = vX(lCount)
lNb = lNb + 1
Next
End If
'lSoFar keeps track ofhow far we got in vX
lSoFar = lCount
'Get a free filenumber
iFile = FreeFile
'Increment the numberfor the new file name
lIncr = lIncr + 1
'Save vY with extension as provided by the user
Open sFile &"-" & lIncr & extn For Output As #iFile
'The Join function makes a text string from the array elements.
Print #iFile,Join$(vY)
Close #iFile
Loop
Erase vX
Erase vY
Exit SubErrorHandle:
MsgBox Err.Description &" Procedure SplitTextFile"
End Sub