Word VBA遍历单列表格排序单元格内容，需修复空单元格循环问题

问题场景 #

我有一个从Excel复制到Word的单列表格，包含数百个单元格，需要用VBA遍历每个单元格，将单元格内的内容按字母顺序排序。但原代码遇到空单元格时，Selection.MoveRight命令会选中整个表格，导致宏回到顶部重复循环，需要修改代码跳过空单元格。

示例单元格内容 #

• Cell1内容：

TM-102
Software V&V Summary
TM-044
Risk Management File RMF151
TM-081
TR-379

• Cell2：空单元格
• Cell3内容：

T-021
TR-1508
TR-1687
Environmental Footprint Analysis - TR-517 
TM-044
Cytotoxicity Study Using the ISO Elution Method (1X MEM Extract) - TM-081
ISO Intracutaneous Study Extract - TM-102
Risk Management File RMF151 - All risks were mitigated to an acceptable level

• Cell4内容：

Rest of World
Brazil
TÜV 19.1833
China
Certificate # 20162543150
Software V&V Summary
Risk Management File RMF151 - All risks were mitigated to an acceptable level.
TEST REPORT
Rest of World
Brazil
China
elements of the alarm systems for expected and unexpected alarm events.
Software V&V Summary

原始VBA代码 #

Sub Sort_cell()
'
' Sort_cell Macro
'
'
    Dim count As Integer
    Dim iteration As Integer
    iteration = 0
        
    count = ActiveDocument.Tables(1).Rows.count
    
    If Selection.Information(wdWithInTable) Then
        Selection.Tables(1).Range.Select
        Selection.Collapse 1
    End If
    
    On Error Resume Next
    
    While Selection.Information(wdWithInTable)
        iteration = iteration + 1
        Selection.Expand unit:=wdCell
        Selection.MoveEnd unit:=wdCharacter, count:=-1
        Selection.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _
        SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
        FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
        wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
        wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
        wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
        :=wdEnglishUS, SubFieldNumber:="Paragraphs", SubFieldNumber2:= _
        "Paragraphs", SubFieldNumber3:="Paragraphs"
        Selection.MoveRight unit:=wdCell, count:=1, Extend:=wdMove
                    
        If iteration = count Then
            Exit Sub
        End If
    Wend

End Sub

修改后的代码（解决空单元格问题） #

Sub SortTableCellContents()
    Dim tbl As Table
    Dim cell As Cell
    Dim cellText As Range
    
    ' 定位到文档中的第一个表格
    Set tbl = ActiveDocument.Tables(1)
    
    ' 遍历表格中的每个单元格
    For Each cell In tbl.Range.Cells
        ' 跳过仅含结束标记的空单元格
        If cell.Range.End - cell.Range.Start > 1 Then
            ' 选中单元格内容（排除单元格结束符）
            Set cellText = cell.Range
            cellText.MoveEnd wdCharacter, -1
            
            ' 对单元格内的段落进行排序
            cellText.Sort _
                ExcludeHeader:=False, _
                FieldNumber:="Paragraphs", _
                SortFieldType:=wdSortFieldAlphanumeric, _
                SortOrder:=wdSortOrderAscending, _
                Separator:=wdSortSeparateByParagraphs, _
                CaseSensitive:=False, _
                LanguageID:=wdEnglishUS
        End If
    Next cell
End Sub

代码优化说明 #

1. 直接遍历单元格：放弃依赖Selection对象的方式，改用For Each循环直接遍历表格单元格，彻底避免空单元格导致的选中异常。
2. 精准空单元格判断：通过cell.Range.End - cell.Range.Start > 1识别空单元格（Word中空单元格仅包含结束标记，长度为1），直接跳过无需处理的单元格。
3. 简化排序参数：移除冗余的多字段排序参数，明确指定按段落分隔排序，让代码逻辑更清晰。
4. 移除错误屏蔽：去掉On Error Resume Next，用明确的条件判断替代，减少隐藏错误的可能性。

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