求大神帮忙修改一个“跨页拆分合并单元格的VBA代码”,原代码仅A列执行,想从第一列到col列都运行一次。

原代码:

Sub 跨页合并单元格拆分() '合并单元格在A列
Dim rng As Range

col = 11 '确定表格共有多少列,有几列就改成几
N = ActiveWindow.SelectedSheets.HPageBreaks.Count
Cells(65536, 1).End(3).Select '活动单元格必须在最后一页
For I = 1 To N
Set rng = ActiveWindow.SelectedSheets.HPageBreaks(I).Location '定位到分页符
rng(0).Resize(2, col).Borders(xlInsideHorizontal).Weight = xlMedium '加粗边框,如果边框是特粗的,请将所有的xlMedium改为xlThick

If rng.MergeArea.Row <> rng.Row Then
'如果分页处被合并
J = rng.MergeArea.Row
K = rng.Row
L = rng.MergeArea.Rows.Count '合并单元格行数
rng.UnMerge '取消合并
Range(Cells(J, 1), rng(0)).Merge '分页符上方合并
Range(rng, Cells(J + L - 1, 1)).Merge '分页符下方合并
rng = Cells(J, 1) '分页符下方赋值
rng(0).Resize(1, col).Borders(xlEdgeBottom).Weight = xlMedium '底部框线
rng.Resize(1, col).Borders(xlEdgeTop).Weight = xlMedium '顶部框线
End If
Next
End Sub

如果有通过把标准的二维表合并的形式实现的也可以,但要求不按行合并。

Sub 跨页合并单元格拆分()    '合并单元格在A列
    Dim rng As Range
    col = 11    '确定表格共有多少列,有几列就改成几
    n = ActiveWindow.SelectedSheets.HPageBreaks.Count
        For I = 1 To n
            ir = ActiveWindow.SelectedSheets.HPageBreaks(I).Location.Row  '定位到分页符
            For j = 1 To col
            Set rng = Cells(ir, j)
            If rng.MergeArea.Row <> ir Then    '如果分页处被合并
                ss = Split(rng.MergeArea.Address, ":")
                ss1 = Split(ss(0), "$")(2)
                ss2 = Split(ss(1), "$")(2)
                rng.UnMerge    '取消合并
                Range(Cells(ss1, j), Cells(ir - 1, j)).Merge    '分页符上方合并
                Range(Cells(ir, j), Cells(ss2, j)).Merge   '分页符下方合并
                rng = Cells(ss1, j)    '分页符下方赋值
            End If
        Next
        Range(Cells(ir - 1, 1), Cells(ir - 1, j)).Borders(xlEdgeBottom).Weight = xlMedium '底部框线
        Range(Cells(ir, 1), Cells(ir, j)).Borders(xlEdgeTop).Weight = xlMedium    '顶部框线
    Next
End Sub

温馨提示:答案为网友推荐,仅供参考
相似回答