求助，通过运行VBA后，将选中的word表格，合并下方相同内容单元格，并保留内容

alw1000

求助，通过运行VBA后，将选中的word表格，合并下方相同内容单元格，并保留内容。具体见附件word文档。对第一个表格运行vba，得到第二个表格结果。

limonet

代码审核。

limonet

Sub MergeCells()
    Dim T As Table, i%, j%, S$
    For Each T In ActiveDocument.Tables
        For i = T.Rows.Count To 2 Step -1
            For j = T.Columns.Count To 1 Step -1
                If T.Cell(i, j).Range.Text = T.Cell(i - 1, j).Range.Text Then
                    S = Left(T.Cell(i, j).Range.Text, Len(T.Cell(i, j).Range.Text) - 2)
                    T.Cell(i, j).Merge MergeTo:=T.Cell(i - 1, j)
                    T.Cell(i - 1, j).Range.Text = S
                End If
            Next j
        Next i
    Next
End Sub

alw1000

limonet 发表于 2023-4-8 17:07
Sub MergeCells()
    Dim T As Table, i%, j%, S$
    For Each T In ActiveDocument.Tables

感谢大佬！！!

alw1000

limonet 发表于 2023-4-8 17:07
Sub MergeCells()
    Dim T As Table, i%, j%, S$
    For Each T In ActiveDocument.Tables

请教一下，有一行代码不太好理解，您能解释一下吗？

S = Left(T.Cell(i, j).Range.Text, Len(T.Cell(i, j).Range.Text) - 2)

这行代码为什么不是“S = T.Cell(i, j).Range.Text”呢？

batmanbbs

alw1000 发表于 2023-4-18 14:42
请教一下，有一行代码不太好理解，您能解释一下吗？

S = Left(T.Cell(i, j).Range.Text, Len(T.Cell( ...

WORD文档获取每个表格单元格的range，其中最后2个字符是一个换行+一个WORD特有表示是表格的符号

alw1000

batmanbbs 发表于 2023-4-18 15:16
WORD文档获取每个表格单元格的range，其中最后2个字符是一个换行+一个WORD特有表示是表格的符号

嗯，谢谢，理解了

alw1000

limonet 发表于 2023-4-8 17:07
Sub MergeCells()
    Dim T As Table, i%, j%, S$
    For Each T In ActiveDocument.Tables

在请问下，如果表格变成了隔空行，能否也做到合并？我尝试了几个参数，都没成功，请指教一下，谢谢。


Sub MergeCells()
    Dim T As Table, i%, j%, S$, c%
    c = InputBox("请输入需要合并的最后一列列数")  '此处为需要合并的最后一列列数，一般取预测楼层前一列
    For Each T In ActiveDocument.Tables
        For i = T.Rows.Count To 4 Step -2
            For j = c To 1 Step -1
                If T.Cell(i, j).Range.Text = T.Cell(i - 2, j).Range.Text Then
                    If T.Cell(i, 1).Range.Text = T.Cell(i - 2, 1).Range.Text Then
                        S = Left(T.Cell(i, j).Range.Text, Len(T.Cell(i, j).Range.Text) - 2)
                        T.Cell(i, j).Merge MergeTo:=T.Cell(i - 2, j)
                        T.Cell(i - 2, j).Range.Text = S
                    End If
                End If
            Next j
        Next i
    Next
End Sub

wdpfox

感觉合并后，不是那么顺眼

alw1000

wdpfox 发表于 2023-4-19 10:40
感觉合并后，不是那么顺眼

是的，不知道是哪里问题