Excel VBA导入Word表格问题：多段落单元格拆分至多行需修复

你的ImportWordTable宏在批量导入Word表格到Excel时，遇到了单元格多段落内容被拆分到多行的问题。下面是修改后的宏代码，能将Word单元格内的多段落内容完整保留在单个Excel单元格中，同时保留段落间的换行格式。

Sub ImportWordTables()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim wdTable As Object
    Dim excelSheet As Worksheet
    Dim filePath As Variant
    Dim i As Integer, j As Integer
    Dim rowNum As Long, colNum As Integer
    Dim cellText As String
    
    ' 选择要导入的Word文档
    filePath = Application.GetOpenFilename("Word文档 (*.docx;*.doc)", , "选择要导入的Word文件", , True)
    If IsArray(filePath) = False Then Exit Sub
    
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False ' 后台运行Word，不显示界面
    
    ' 设置要导入到的Excel工作表（这里用当前活动工作表，可按需修改）
    Set excelSheet = ActiveSheet
    rowNum = 1 ' 从第1行开始写入
    
    ' 遍历选中的每个Word文档
    For Each file In filePath
        Set wdDoc = wdApp.Documents.Open(file)
        
        ' 遍历文档中的每个表格
        For Each wdTable In wdDoc.Tables
            ' 遍历表格的每一行
            For i = 1 To wdTable.Rows.Count
                colNum = 1
                ' 遍历当前行的每个单元格
                For j = 1 To wdTable.Rows(i).Cells.Count
                    ' 获取单元格内的所有文本，保留段落换行
                    cellText = wdTable.Rows(i).Cells(j).Range.Text
                    ' 移除Word单元格末尾的特殊标记（通常是Chr(13)+Chr(7)）
                    cellText = Left(cellText, Len(cellText) - 2)
                    ' 将段落分隔符替换为Excel的换行符（vbCrLf）
                    cellText = Replace(cellText, Chr(13), vbCrLf)
                    
                    ' 将处理后的文本写入Excel单元格
                    excelSheet.Cells(rowNum, colNum).Value = cellText
                    ' 自动调整单元格行高以适应多内容
                    excelSheet.Rows(rowNum).AutoFit
                    colNum = colNum + 1
                Next j
                rowNum = rowNum + 1
            Next i
            ' 不同Word表格之间空一行分隔
            rowNum = rowNum + 1
        Next wdTable
        
        wdDoc.Close SaveChanges:=False
    Next file
    
    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set excelSheet = Nothing
    
    MsgBox "表格导入完成！", vbInformation
End Sub

关键修改说明 #

• 读取完整单元格内容：直接读取Cells(j).Range.Text而非逐段落遍历，确保获取单元格内所有内容
• 清理特殊字符：移除Word单元格末尾默认的Chr(13)+Chr(7)标记，避免导入后出现多余符号
• 保留段落格式：将Word的段落分隔符Chr(13)替换为Excel支持的换行符vbCrLf，开启Excel单元格的「自动换行」后，就能看到和Word一致的多段落排版
• 自动适配行高：添加Rows(rowNum).AutoFit让Excel行高自动匹配内容高度，避免内容被遮挡

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