大CSV转XLS丢失数据、转XLSX无法打开的VBA代码问题求助

一、解决大CSV转换丢行问题 #

方法1：确保CSV完全加载后再操作 #

大CSV文件打开时，Excel后台加载过程可能被VBA跳过，导致数据未完全导入。可以通过禁用非必要功能、循环等待加载完成来解决：

Sub ConvertCSVtoXLS()
    Dim csvPath As String, xlsPath As String
    csvPath = "C:\your_target.csv" '替换为你的CSV路径
    xlsPath = Replace(csvPath, ".csv", ".xls")
    
    '关闭干扰性设置，提升加载效率
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    '打开CSV时指定分隔符和区域设置，避免解析错误
    Dim wb As Workbook
    Set wb = Workbooks.Open(Filename:=csvPath, _
        Format:=2, '逗号分隔，按需调整：1=制表符、2=逗号
        Delimiter:=",", _
        Local:=True)
    
    '循环等待加载完成，检查状态栏或已用行数
    Do While Application.StatusBar = "正在打开..." Or wb.Sheets(1).UsedRange.Rows.Count < 1
        DoEvents '释放CPU资源，让Excel完成加载
    Loop
    
    '保存后关闭
    wb.SaveAs Filename:=xlsPath, FileFormat:=xlExcel8
    wb.Close SaveChanges:=False
    
    '恢复默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

方法2：无需打开文件直接转换（用PowerQuery） #

超大型CSV可以通过PowerQuery直接导入保存，避开打开文件的内存限制：

Sub ConvertCSVtoExcelWithoutOpen()
    Dim csvPath As String, excelPath As String
    csvPath = "C:\your_target.csv"
    excelPath = Replace(csvPath, ".csv", ".xls")
    
    '创建空白工作簿
    Dim wb As Workbook
    Set wb = Workbooks.Add
    
    '用PowerQuery同步导入CSV数据
    With wb.QueryTables.Add(Connection:="TEXT;" & csvPath, Destination:=wb.Sheets(1).Range("A1"))
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .TextFileLocal = True
        .Refresh BackgroundQuery:=False '强制同步完成后再执行后续操作
    End With
    
    '保存并关闭
    wb.SaveAs Filename:=excelPath, FileFormat:=xlExcel8
    wb.Close SaveChanges:=False
End Sub

二、解决XLSX格式无法打开的问题 #

XLSX打不开的核心原因是保存格式参数错误，需用对应格式代码xlOpenXMLWorkbook，同时确保数据解析正确：

Sub ConvertCSVtoXLSX()
    Dim csvPath As String, xlsxPath As String
    csvPath = "C:\your_target.csv"
    xlsxPath = Replace(csvPath, ".csv", ".xlsx")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim wb As Workbook
    Set wb = Workbooks.Open(Filename:=csvPath, _
        Format:=2, _
        Delimiter:=",", _
        Local:=True, _
        ReadOnly:=True)
    
    '等待数据完全加载
    Do While wb.Sheets(1).Cells(wb.Sheets(1).Rows.Count, 1).End(xlUp).Row < 1 '循环直到有数据加载完成
        DoEvents
    Loop
    
    '关键：XLSX必须用xlOpenXMLWorkbook格式代码
    wb.SaveAs Filename:=xlsxPath, FileFormat:=xlOpenXMLWorkbook
    wb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

额外注意事项 #

• 旧版Excel（2003及更早）不支持XLSX格式，需升级到2007+版本。
• 若CSV为UTF-8编码，打开时需设置Local:=False，或在PowerQuery中指定UTF-8编码，避免乱码导致保存失败。
• 转换前确认CSV未被其他程序占用，否则会导致数据写入不完整。

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