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

时间:2018-06-26 04:13:01

标签: excel vba excel-vba

我正在尝试清理CSV数据以更正Fisrt名称和姓氏格式。 它可以在我的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

0 个答案:

没有答案