格式化(动态)

时间:2015-07-27 08:40:04

标签: vba excel-vba excel-2010 excel

enter image description here

大家好,

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

但是我希望像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

2 个答案:

答案 0 :(得分:3)

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

即可
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

示例

enter image description here

答案 1 :(得分:1)

以下是执行此任务的代码。您需要传递初始单元格的地址(使用文本&#39; Column1 &#39;)作为此函数的输入参数,即Call formatArray("A2")

数组的第一列和最后一列定义为常量FIRST_COLLAST_COL,当前设置为1和5 - 如果数组位于其他列中,只需更改常量值。 / p>

Public Sub formatArray(startCell As String)
    Const FIRST_COL As Integer = 1
    Const LAST_COL As Integer = 5
    '--------------------------------------------
    Dim wks As Excel.Worksheet
    Dim initialCell As Excel.Range
    '--------------------------------------------
    Dim region As Excel.Range
    Dim firstRow As Long
    Dim lastRow As Long
    Dim row As Long
    Dim rng As Excel.Range
    Dim groups As New VBA.Collection
    Dim groupStartRow As Long
    '--------------------------------------------


    Set wks = Excel.ActiveSheet
    Set initialCell = wks.Range(startCell)
    Set region = initialCell.CurrentRegion
    firstRow = initialCell.row
    lastRow = region.Cells(region.Cells.Count).row



    'Divide range into groups. -----------------------------------------------------
    For row = firstRow To lastRow

        If Not IsEmpty(wks.Cells(row, FIRST_COL).value) Or row = lastRow Then

            If groupStartRow Then
                With wks
                    Set rng = .Range(.Cells(groupStartRow, FIRST_COL), _
                                     .Cells(IIf(row = lastRow, row, row - 1), LAST_COL))
                    Call groups.Add(rng)
                End With
            End If

            groupStartRow = row

        End If

    Next row
    '-------------------------------------------------------------------------------



    'At this point whole region is divided into smaller parts. Each part contains
    'the rows that are merged in first column. Now we apply border formatting to
    'each subregion separately.
    For Each rng In groups
        With rng
            Call .BorderAround(xlContinuous, xlThick, 0, 0)

            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 15
                .Weight = xlThin
            End With

            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 15
                .Weight = xlThin
            End With

        End With
    Next rng

End Sub