Excel宏导出CSV时额外生成10条空记录，如何调整代码修复？

问题背景 #

我编写了一个可实现预期功能的Excel宏，但导出CSV文件时总会额外添加10条空行（显示为逗号），当用户将该CSV上传至外部门户时，会生成10条空记录。请指出需移除或调整宏代码中的哪部分来解决该问题？

原始宏代码 #

Sub simpleXlsMerger() 
    Dim bookList As Workbook 
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 
    Application.ScreenUpdating = False 
    Set mergeObj = CreateObject("Scripting.FileSystemObject") 
    'change folder path of excel files here 
    Set dirObj = mergeObj.Getfolder("\\chr-fss001\DataJapan\Sagawa\Sagawa_CSV\") 
    Set filesObj = dirObj.Files 
    For Each everyObj In filesObj 
        Set bookList = Workbooks.Open(everyObj) 
        'change "A2" with cell reference of start point for every files here 
        'for example "B3:IV" to merge all files start from columns B and rows 3 
        'If you're files using more than IV column, change it to the latest column 
        'Also change "A" column on "A65536" to the same column as start point 
        Range("A1:DZ1" & Range("A65536").End(xlUp).Row).Copy 
        ThisWorkbook.Worksheets(1).Activate 
        'Do not change the following column. It's not the same column as above 
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial 
        Application.CutCopyMode = False 
        bookList.Close 
    Next 
    Columns("A:A").Select 
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _ 
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ 
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _ 
        )), TrailingMinusNumbers:=True 
    ActiveSheet.Shapes.Range(Array("Button 1")).Select 
    Rows("1:1").Select 
    Selection.Delete Shift:=xlUp 
    Range("A1").Select 
    Range("I1").Select 
    Sheets("Sheet1").Select 
    Columns("I:L").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Blad1").Select 
    Columns("I:I").Select 
    Selection.Insert Shift:=xlToRight 
    Range("A1").Select 
    Dim Lastrow As Long 
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row 
    Cells(Lastrow, "A").Select 
    ActiveCell.Offset(1).Select 
    ActiveCell.EntireRow.Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.ClearContents 
    Range("A1").Select 
    ChDir "J:\Sagawa\DailyPortalFile" 
    ActiveWorkbook.SaveAs Filename:= _ 
        "J:\Sagawa\DailyPortalFile\" & Format(Now, "yyyy-mm-dd hh mm") & " Sagawa", FileFormat:=xlCSV, _ 
        CreateBackup:=False 
End Sub

问题现象 #

问题根源与修复方案 #

嘿，这个问题的核心出在你清理空行的代码段上！让我给你拆解清楚：

问题代码段

这段代码是导致多余空行的元凶：

Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(Lastrow, "A").Select
ActiveCell.Offset(1).Select
ActiveCell.EntireRow.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

当你执行Selection.End(xlDown)时，因为当前选中的是最后一行数据的下一行（空行），这个操作会直接跳到工作表的最后一行（旧Excel是65536行，新版本是1048576行）。你随后清空了这个大范围内的内容，但这些行本身并没有被删除——Excel在导出CSV时，会把这些空行对应的列（因为你之前有列插入操作，列数较多）输出为逗号分隔的空值，也就是你看到的只有逗号的多余行。

修复代码

把上面那段代码替换成直接删除多余行的逻辑，而不是清空内容：

Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
' 删除最后一行数据之后的所有行，彻底移除空行
Rows(Lastrow + 1 & ":" & Rows.Count).Delete Shift:=xlUp

额外优化提示

另外，你的复制数据代码里有个小笔误：Range("A1:DZ1" & Range("A65536").End(xlUp).Row)应该改成Range("A1:DZ" & Range("A65536").End(xlUp).Row)（多了个多余的1），不过这个不是导致空行的直接原因，但修正后能避免潜在的范围选择错误。

这样修改后，导出的CSV就不会再出现那些多余的逗号空行，上传门户时也不会生成空记录啦！

内容的提问来源于stack exchange，提问作者Eelco