vba - Excel VBA -- 编辑 1,000,000 行 CSV

Question

我正在尝试清理 CSV 数据以更正名字和姓氏格式。它在我的 PC 机器上运行良好（大约需要 20 秒才能完成）并且所有数据都可能处理得很好。但我的朋友告诉我，它在她的机器上不起作用，只需要 4 秒就可以停止。并非所有数据都已处理。

下面的代码有什么问题？谢谢

Sub CleanUpCSV()
Dim fso As FileSystemObject
Dim sCSV As TextStream, oCSV As TextStream
Dim sFile As String, oFile As String, sFileName As String, oFileName As String
Dim ln As String
Dim varData As Variant, varName As Variant
Dim CName As Long, FName As Long, LName As Long
Dim sFilePath As String, sFolderPath As String
Dim FilterIndex As Integer
Dim filter As String
Dim fd As FileDialog
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim lfn As Long, lln As Long, lcn As Long


FastWB True
'open the Sage CSV file
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .AllowMultiSelect = False
   ' .InitialFileName = local_path
    .Title = "Please select csv file to be cleaned up"
    .Filters.Clear
    .Filters.Add "CSV Files", "*.csv"
    If .Show = -1 Then
        sFilePath = .SelectedItems(1)
        sFile = sFilePath
    End If
End With

If Len(sFilePath) > 0 Then
    'Remember time when macro starts
    StartTime = Timer

    Set fso = New FileSystemObject
    sFileName = fso.GetFileName(sFile)
    sFolderPath = fso.GetParentFolderName(sFile)

    oFileName = "Cleaned_" & sFileName
    oFile = sFolderPath & Application.PathSeparator & oFileName

    CName = 3 'Complete Name, 4th Column
    FName = 4 'First Name, 5th Column
    LName = 5 'Last Name, 6th Column

    On Error Resume Next
    Set sCSV = fso.OpenTextFile(sFile, ForReading, False)
    Set oCSV = fso.CreateTextFile(oFile, True)
    On Error GoTo 0

    On Error GoTo errHandler
    Do While Not sCSV.AtEndOfStream
        ln = sCSV.ReadLine
        varData = Split(ln, ",")
        lfn = UBound(Split(CStr(varData(FName)), " "))
        lln = UBound(Split(CStr(varData(LName)), " "))

        If Not LCase(CStr(varData(CName))) Like "*name" Then 'ignore 1st line
            If lfn < 1 And lln > 0 Then
                varName = Split(CStr(varData(LName)), " ")
                If UBound(varName) > LBound(varName) Then
                    varData(FName) = varName(UBound(varName))
                    varData(LName) = varName(LBound(varName))
                    varData(CName) = varData(FName) & " " & varData(LName)
                End If
            End If

            If lfn > 0 And lln < 1 Then
                varName = Split(CStr(varData(FName)), " ")
                If UBound(varName) > LBound(varName) Then
                    varData(FName) = varName(UBound(varName))
                    varData(LName) = varName(LBound(varName))
                    varData(CName) = varData(FName) & " " & varData(LName)
                End If
            End If

            If lfn > -1 And lln > -1 Then
                varData(CName) = varData(FName) & " " & varData(LName)
            End If
        End If
        ln = Join(varData, ",")
        oCSV.WriteLine ln
    Loop

    sCSV.Close
    oCSV.Close
    Set sCSV = Nothing
    Set oCSV = Nothing
    Set fso = Nothing

    'Determine how many seconds code took to run
    SecondsElapsed = Round(Timer - StartTime, 2)

    MsgBox "Clean up completed in " & SecondsElapsed & "seconds." & vbCrLf & _
            "Pls check: " & oFileName, vbOKOnly + vbInformation
    Call OpenFolder(sFolderPath)
Else
    MsgBox "No file selected.", vbOKOnly + vbCritical

End If

ExitSub:
'clean up before exiting
FastWB False
Exit Sub

errHandler:
MsgBox "Error", vbOKOnly + vbCritical
Resume ExitSub

End Sub

标签： vbaexcel