☰

Excel 宏根据值格式化单元格并使用下面的空白行进行分组

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba macros
Excel 宏根据值格式化单元格并使用下面的空白行进行分组

我正在尝试创建一个 Excel 宏来格式化从另一个程序导出的一些数据。以下是数据布局的示例：

ID        Code      SubCodes
1         A1        1
1                   30
1         B2        23
1                   35
2         A1        1
2                   30
2         A1        6
2                   10
2                   12
2         C3        2
2         C3        4

我想使用格式创建主要“组”和次要“组”。我不一定想使用 Excel 的分组功能。我想先按 ID 分组，这很容易，然后在每个 ID 后添加一条粗体边框线。我遇到麻烦的部分是次要组，因为如果子代码超过 1 个，则子代码在其行上没有父代码，并且可以有多个具有不同子代码的代码。然后，每个次要组后面的边框线会更暗。

以下是所需格式的示例：

ID        Code      SubCodes
============================
1         A1        1
1                   30
----------------------------
1         B2        23
1                   35
============================
2         A1        1
2                   30
----------------------------
2         A1        6
2                   10
2                   12
----------------------------
2         C3        2
----------------------------
2         C3        4
============================

那么我怎样才能让这些小组包含下面有空白代码的行呢？
最好使用宏，因为文件是从程序中导出的，然后需要格式化。但是，如果有更好的方法，我绝对愿意接受。最终目标是使数据易于阅读。

这是我现在为主要分组创建格式的代码。

Sub Macro1()

    Dim StartRow As String
    Dim LastRow As Integer
    Dim Rng As Range
    Dim cValue As String

    Application.ScreenUpdating = False

    StartRow = "1"
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Set Rng = Range("A" & StartRow, "A" & LastRow)

    Cells.ClearOutline

    cValue = Range("A" & StartRow).Value
    For Each Cell In Rng
        If Cell.Value <> cValue Then
            With Cell.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
        Else
            cValue = Cell.Value
        End If
    Next Cell

    Application.ScreenUpdating = True 

End Sub

答案1

这应该可行（根据您的喜好更改） -

Sub Macro1()

     Dim LastRow As Integer
     LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
     ActiveSheet.Cells.Borders.LineStyle = xlNone

    For Each c In Range("A1:A" & LastRow)
        If c <> c.Offset(1) Then
            With Range(c, c.Offset(, 2)).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With

        End If
    Next

    For Each c In Range("B1:B" & LastRow)
        If c.Borders(xlEdgeBottom).LineStyle = xlNone And c.Offset(1) <> "" Then
            With Range(c.Offset(, -1), c.Offset(, 1)).Borders(xlEdgeBottom)
                .LineStyle = xlDashDot
            End With
        End If
    Next

End Sub

相关内容