Макрос Excel для форматирования ячеек на основе значения и группы с пустыми строками ниже

Question

Я пытаюсь создать макрос 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. Я хотел бы сначала сгруппировать по идентификатору, что достаточно просто, и добавить большую жирную границу после каждого идентификатора. Часть, с которой у меня возникли проблемы, - это второстепенные группы, так как подкоды не содержат родительский код в строке, если их больше 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

Answer 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