VBA拆分.xlsx为带表头的.csv及日期格式修复技术问询

一、输出XML文件的原因及修复 #

原代码中FileFormat:=-4143对应的是xlXMLSpreadsheet格式，这就是输出文件变成XML的根本原因。Windows平台下CSV格式的正确FileFormat常量是6（xlCSV）。同时，保存CSV时Excel会弹出格式兼容提示，需要关闭提示避免代码中断。

修复步骤：

• 将.SaveAs语句中的FileFormat:=-4143替换为FileFormat:=6
• 在保存前后添加Application.DisplayAlerts控制，关闭保存提示

二、日期格式不统一的修复 #

CSV是纯文本格式，Excel默认会根据系统区域设置自动转换日期，导致单日（如5号）显示为d/mm/yyyy。解决方法是将日期单元格强制转换为文本格式的dd/mm/yyyy，确保格式统一。

修复逻辑：

• 遍历新工作簿中的数据单元格，判断是否为日期类型
• 将日期单元格设置为文本格式，并用Format函数强制转换为dd/mm/yyyy格式

完整修改后的VBA代码 #

Sub SplitToCSV()
    Dim ACS As Range, Z As Long, New_WB As Workbook
    Dim Total_Columns As Long, Start_Row As Long, Stop_Row As Long, Copied_Range As Range
    Dim Headers() As Variant
    Dim cell As Range
    
    Set ACS = ActiveSheet.UsedRange
    
    With ACS
        Headers = .Rows(1).Value
        Total_Columns = .Columns.Count
    End With
    
    Start_Row = 2
    Z = 0
    Stop_Row = 0 ' 初始化循环变量
    
    Do While Stop_Row <= ACS.Rows.Count
        Z = Z + 1
        
        If Z > 1 Then Start_Row = Stop_Row + 1
        
        Stop_Row = Start_Row + 499
        With ACS.Rows
            If Stop_Row > .Count Then Stop_Row = .Count
        End With
        
        With ACS
            Set Copied_Range = .Range(.Cells(Start_Row, 1), .Cells(Stop_Row, Total_Columns))
        End With
        
        Set New_WB = Workbooks.Add
        
        With New_WB
            With .Worksheets(1)
                ' 写入表头
                .Cells(1, 1).Resize(1, Total_Columns) = Headers
                ' 写入数据
                .Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns) = Copied_Range.Value
                
                ' 统一日期格式为dd/mm/yyyy文本
                For Each cell In .Range(.Cells(2, 1), .Cells(Stop_Row - Start_Row + 2, Total_Columns))
                    If IsDate(cell.Value) Then
                        cell.NumberFormat = "@"
                        cell.Value = Format(cell.Value, "dd/mm/yyyy")
                    End If
                Next cell
            End With
            
            ' 关闭保存提示，避免代码中断
            Application.DisplayAlerts = False
            .SaveAs Filename:=ACS.Parent.Path & Application.PathSeparator & "file-" & Z & ".csv", FileFormat:=6
            .Close SaveChanges:=False
            Application.DisplayAlerts = True
        End With
        
        If Stop_Row = ACS.Rows.Count Then Exit Do
    Loop
End Sub

额外说明 #

• 如果你的日期列固定，可以直接针对指定列处理，无需遍历所有单元格，能提升效率。比如将日期列设为第3列，替换遍历代码为：

  ' 处理固定日期列（示例：第3列）
  With .Columns(3)
      .NumberFormat = "@"
      .Range(.Cells(2, 1), .Cells(Stop_Row - Start_Row + 2, 1)).Value = _
          Evaluate("TEXT(" & .Range(.Cells(2, 1), .Cells(Stop_Row - Start_Row + 2, 1)).Address & ",""dd/mm/yyyy"")")
  End With
  

• 若使用Mac平台，CSV格式的FileFormat常量为22（xlCSVMac），需替换对应参数。

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