vba - 格式化(动态)

Question

大家好，

请查看上面的图片，我有两张 table 。在下面代码的第一个表中，我得到了这种格式。

但我想像 Table2 那样格式化，每个合并单元格中的行数是动态的，而且不一样。

有没有办法像table2一样格式化？

Range("B6:H" & LastRow2).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThick
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThick
End With

Answer 1

只需将此代码添加到上述代码的末尾

For i = 6 To LastRow2
    If Range("B" & i - 1).MergeCells = True And Range("B" & i).MergeCells = True And _
    Range("B" & i - 1).MergeArea.Address = Range("B" & i).MergeArea.Address Then
        Range("B" & i - 1 & ":H" & i).Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
Next i

因此，如果我将您的代码和我的代码结合起来，它将看起来像这样

StartRow = 6 '<~~ For example
LastRow = 25 '<~~ For example

With Range("B" & StartRow & ":H" & LastRow)
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
End With

On Error Resume Next '<~~ Required if the StartRow = 1
For i = StartRow To LastRow
    If Range("B" & i - 1).MergeCells = True And Range("B" & i).MergeCells = True And _
    Range("B" & i - 1).MergeArea.Address = Range("B" & i).MergeArea.Address Then
        Range("B" & i - 1 & ":H" & i).Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
Next i
On Error GoTo 0

示例