批量：表格行中多列被合并，现在要折分

菜菜行者

刚开始时如图第一个表，“市”和“省内”所在的行被合并了
需要做成如图第二个表，“市”和“省内”所在的行折分多列，等同于上下行



测试.rar (4.42 KB, 下载次数: 5)

2017-12-2 14:37 上传

点击文件名下载附件

我的思路是：查找字体—剪切—光标向下移动一行—插入行（在上方）—光标向左移动—粘贴—光标向上移动1格—删除表格行
希望老师们做成宏进行批量操作，先谢谢了

jiminyanyan

手工整一下吧,这种需求也不经常做....

菜菜行者

jiminyanyan 发表于 2017-12-2 15:32
手工整一下吧,这种需求也不经常做....

是不经常有，但内容很多，有近3千页，工作量太大了

duquancai

Sub shishi()
    Dim c&, tb As Table
    If ActiveDocument.Tables.Count < 1 Then Exit Sub
    For Each tb In ActiveDocument.Tables
        If tb.Rows.Count >= 2 Then
            For i = 2 To tb.Rows.Count
                If tb.Rows(i).Range.Cells.Count = 1 Then
                    c = tb.Rows(i).Range.Previous(wdRow).Cells.Count
                    tb.Rows(i).Range.Cells.Split 1, c, True
                End If
            Next
        End If
    Next
End Sub

菜菜行者

duquancai 发表于 2017-12-2 16:36
Sub shishi()
    Dim c&, tb As Table
    If ActiveDocument.Tables.Count < 1 Then Exit Sub

服杜老师，谢谢杜老师

菜菜行者

duquancai 发表于 2017-12-2 16:36
Sub shishi()
    Dim c&, tb As Table
    If ActiveDocument.Tables.Count < 1 Then Exit Sub

如何在最后一列再加一列？

duquancai

菜菜行者 发表于 2017-12-2 22:55
如何在最后一列再加一列？

Sub shishi()
    Dim c&, tb As Table
    If ActiveDocument.Tables.Count < 1 Then Exit Sub
    Application.ScreenUpdating = False
    For Each tb In ActiveDocument.Tables
        If tb.Rows.Count >= 2 Then
            For i = 2 To tb.Rows.Count
                If tb.Rows(i).Range.Cells.Count = 1 Then
                    n = n + 1
                    c = tb.Rows(i).Range.Previous(wdRow).Cells.Count
                    tb.Rows(i).Range.Cells.Split 1, c, True
                End If
            Next
        End If
        If n > 0 Then
            tb.Columns(c).Select: n = 0
            Selection.InsertColumnsRight
            tb.AutoFitBehavior (2)
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "ok!"
End Sub

菜菜行者

duquancai 发表于 2017-12-3 00:02
Sub shishi()
    Dim c&, tb As Table
    If ActiveDocument.Tables.Count < 1 Then Exit Sub

是我想要的，谢谢杜老师

菜菜行者

duquancai 发表于 2017-12-3 00:02
Sub shishi()
    Dim c&, tb As Table
    If ActiveDocument.Tables.Count < 1 Then Exit Sub

我忽略了一种情况，上传的附件每列的宽度是一样的，使用上面的代码运行是没问题的
但是，如何列宽不一样时，是出错的，且只处理了第一个表格。

杜老师，麻烦再帮我改改，谢谢了

duquancai

菜菜行者 发表于 2017-12-4 21:48
我忽略了一种情况，上传的附件每列的宽度是一样的，使用上面的代码运行是没问题的
但是，如何列宽不一样 ...

自己修改。。。。。。。。。。。。。。