VBA实现XLSM/XLSX转CSV：行内单元格分号拼接问题求助

我用VBA将XLSM文件转换为CSV，需求是把每行所有单元格内容用分号拼接后合并到该行第一列，但现有代码存在问题：部分行未完成全部单元格拼接，生成的CSV中部分行仍保留多列。需要新算法，要求即使单元格内包含逗号，也能正确用分号拼接每行所有内容。

示例单元格内容 #

ID   供应商          理由
4    某供应商   理由描述中包含ID，且存在逗号。  

预期输出 #

id;供应商;理由
4;某供应商;理由描述中包含ID，且存在逗号。

原代码 #

Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Tbl() As String
Dim Ligne As String
Dim Dossier As String
Dim Chemin As String
Dim Fichier As String
Dim i As Long
Dim j As Long

Dossier = "C:\my_path"

Fichier = "My_Name " & Format(Now, "dd-mm-yyyy") & ".csv"

'full path
Chemin = Dossier & Fichier

Set Fe = Worksheets("Upload")

Set Plage = DefPlage(Fe, 1, 1)

For i = 1 To Plage.Rows.Count

    For j = 1 To Plage.Columns.Count: Ligne = Ligne & Plage(i, j).Value & ",": Next j

    'delete the ; at the end
    Ligne = Left(Ligne, Len(Ligne) - 1)

    'store in a table
    ReDim Preserve Tbl(1 To i)
    Tbl(i) = Ligne

    'For the next on
    Ligne = ""

Next i

'create .csv file
Open Chemin For Output As #1

    For i = 1 To UBound(Tbl): Print #1, Tbl(i): Next i

Close #1

Function DefPlage(Fe As Worksheet, L As Long, C As Long) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

问题分析 #

原代码的核心问题：

1. 分隔符逻辑混乱：代码用逗号拼接内容，但注释写的是要去掉分号，导致生成的内容仍是逗号分隔，CSV解析时会把单元格内的逗号识别为列分隔符，出现多列。
2. 数据范围不准确：DefPlage函数用Find查找最后一行/列，若工作表存在空白行/列，可能导致范围未覆盖所有有效数据，部分行拼接不完整。

修正后的代码 #

Sub XLSMToCSVWithSemicolon()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim lineText As String
    Dim savePath As String
    
    ' 设置CSV保存路径和文件名
    savePath = "C:\my_path\My_Name " & Format(Now, "dd-mm-yyyy") & ".csv"
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("Upload")
    
    ' 获取准确的有效数据范围
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' 创建并写入CSV文件
    Open savePath For Output As #1
        For i = 1 To lastRow
            lineText = ""
            For j = 1 To lastCol
                ' 用分号拼接单元格内容
                lineText = lineText & ws.Cells(i, j).Value & ";"
            Next j
            ' 移除末尾多余的分号
            If Len(lineText) > 0 Then
                lineText = Left(lineText, Len(lineText) - 1)
            End If
            ' 写入当前行内容
            Print #1, lineText
        Next i
    Close #1
    
    MsgBox "CSV文件已生成：" & savePath, vbInformation
End Sub

关键改进点 #

• 分隔符统一：全程使用分号拼接内容，避免CSV解析时误将单元格内的逗号识别为列分隔符。
• 准确获取数据范围：用End(xlUp)和End(xlToLeft)定位最后一行和列，确保覆盖所有有效数据，解决部分行拼接不完整的问题。
• 简化逻辑：移除不必要的数组存储，直接逐行拼接并写入文件，提升运行效率。
• 容错处理：判断行内容长度后再移除末尾分号，避免空行报错。

内容的提问来源于stack exchange，提问作者Pierre-Emmanuel giuglaris