保存宏表后 CSV 中的额外行

Question

我有一个可以格式化一些数据的宏。但由于某种原因，它用逗号保存了额外的行，这给我带来了问题。我的宏是否有问题导致此问题或如何解决此问题？数据以 Excel 文件的形式提供给我。我将它与宏一起粘贴到我的工作表中，运行它，然后另存为 CSV。

宏代码：

    Option Explicit

Sub runClick()
    
    ' remove MRT rows
    Application.DisplayAlerts = False
    
    Dim rng As Range
    Dim LR As Long
    Dim LC As Long
    LR = Worksheets("WeeklyWelcomeEmailData").Cells(Rows.Count, 1).End(xlUp).Row
    LC = Worksheets("WeeklyWelcomeEmailData").Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set rng = ThisWorkbook.Worksheets("WeeklyWelcomeEmailData").Range("A1:Z" & LR)
    
    rng.AutoFilter Field:=4, Criteria1:="MRT"
    rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete
    
    AutoFilterMode = False
    
    Application.DisplayAlerts = True
    
    ' find and replace Purpose column (S)
    Range("S:S").Replace What:="PURCHASE", Replacement:="Purchase", MatchCase:=False
    Range("S:S").Replace What:="RESELL", Replacement:="Resale", MatchCase:=False
    
    ' remove commas and extra spaces in Vendor column (F)
    Dim tVendor As String
    tVendor = "F1:F" & Cells(Rows.Count, "F").End(xlUp).Row
    Range(tVendor) = Evaluate("IF(" & Range(tVendor).Address(0, 0) & "="""","""",Trim(SUBSTITUTE(" & Range(tVendor).Address(0, 0) & ","","","" "")))")
    
    ' format to short date
    'H
    Dim tShortDate1 As String
    tShortDate1 = "H1:H" & Cells(Rows.Count, "H").End(xlUp).Row
    Range(tShortDate1).NumberFormat = "m/d/yyyy"
    'T
    Dim tShortDate2 As String
    tShortDate2 = "T1:T" & Cells(Rows.Count, "T").End(xlUp).Row
    Range(tShortDate2).NumberFormat = "m/d/yyyy"
    'X
    Dim tShortDate3 As String
    tShortDate3 = "X1:X" & Cells(Rows.Count, "X").End(xlUp).Row
    Range(tShortDate3).NumberFormat = "m/d/yyyy"
    'Y
    Dim tShortDate4 As String
    tShortDate4 = "Y1:Y" & Cells(Rows.Count, "Y").End(xlUp).Row
    Range(tShortDate4).NumberFormat = "m/d/yyyy"

End Sub

保存后输出

Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,

Answer 1

“清理”导入的数据

Option Explicit

Sub runClick()
    
    Const FilterField As Long = 4
    Const FilterCriteria1 As String = "MRT"
    Const sdColumns As String = "H:H,T:T,X:X,Y:Y"
    Const sdFormat As String = "m/d/yyyy" ' possibly "m\/d\/yyyy"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets("WeeklyWelcomeEmailData")
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    ' Create a reference to the Table Range (headers included).
    Dim trg As Range: Set trg = ws.Range("A1").CurrentRegion
    
    ' Validate.
    Dim trCount As Long: trCount = trg.Rows.Count
    If trCount = 1 Then Exit Sub ' one row only (no data)
    Dim tcCount As Long: tcCount = trg.Columns.Count
    If tcCount < FilterField Then Exit Sub ' too few columns
    
    ' Create a reference to the Data Range (without headers).
    Dim drg As Range: Set drg = trg.Resize(trCount - 1).Offset(1)
    'Debug.Print trg.Address, drg.Address
    
    ' Delete criteria rows.
    trg.AutoFilter Field:=FilterField, Criteria1:=FilterCriteria1
    If Application.Subtotal(103, trg.Columns(FilterField)) > 1 Then
        ' Create a reference to the SpecialCells Range.
        Dim scrg As Range: Set scrg = drg.SpecialCells(xlCellTypeVisible)
        'Debug.Print scrg.Address
        ' Note that by first turning off the AutoFilterMode and only
        ' then deleting, the cells to the right of the Table Range
        ' are not affected. (The cells to the bottom are shifted up.)
        ws.AutoFilterMode = False
        scrg.Delete
    Else
        ws.AutoFilterMode = False
    End If
    
    ' Validate.
    If drg Is Nothing Then Exit Sub ' all data rows did contain the criteria
    'Debug.Print trg.Address, drg.Address
    
    Dim cCol As Long
    
    ' find and replace Purpose column (S)
    cCol = 19 ' S
    If tcCount >= cCol Then
        drg.Columns(cCol).Replace "PURCHASE", "Purchase", xlWhole, , False
        drg.Columns(cCol).Replace "RESELL", "Resale", xlWhole, , False
    End If
    
    ' remove commas and extra spaces in Vendor column (F)
    cCol = 6 ' F
    If tcCount >= cCol Then
        With drg.Columns(cCol)
            .Value = Evaluate("IF(" & .Address(0, 0) _
                & "="""","""",Trim(SUBSTITUTE(" & .Address(0, 0) _
                & ","","","" "")))")
        End With
    End If
    
    ' format to short date in columns (H,T,X,Y)
    cCol = 25 ' Y
    If tcCount >= cCol Then
        Intersect(drg, ws.Range(sdColumns)).NumberFormat = sdFormat
    End If

    'wb.Save

End Sub