Таблица форматирования VBA со слитыми ячейками

Question

У меня есть функция, которая объединяет ячейки в таблице, если весь диапазон имеет одинаковое значение (например, если A1: G1 равен A2: B2, он объединит ячейки, такие как A1 и A2, B1 & B2 и т. Д. Подробнее здесь: Как проверить, равно ли значение двух диапазонов ) Теперь я хотел бы изменить цвет таблицы, созданной этой функцией, например, первую строку (не имеет значения, объединены или нет), заполненную цветом, второй пробел и т. Д., НоЯ понятия не имею, должен ли я раскрасить ее с помощью функции слияния или создать другую, которая будет обнаруживать новую таблицу с объединенными строками как одну и т. Д. Ниже мой код:

Sub test()

    Dim i As Long, j As Long, k As Long, row As Long
    row = Cells(Rows.Count, 2).End(xlUp).row
    k = 1
    For i = 1 To row Step 1
        If Cells(i, 1).Value = "" Then Exit For
        If Join(Application.Transpose(Application.Transpose(Range(Cells(i, 1), Cells(i, 3)))), Chr(0)) <> Join(Application.Transpose(Application.Transpose(Range(Cells(i + 1, 1), Cells(i + 1, 3)))), Chr(0)) Then
          If i <> k Then
            For j = 1 To 3 Step 1
                  Application.DisplayAlerts = False
                  Range(Cells(i, j), Cells(k, j)).Merge
                  Application.DisplayAlerts = True
            Next j
          End If
        k = i + 1
        End If
    Next i
End Sub 

Answer 1

Итак, через некоторое время я понял это сам. Ниже приведен код:

Dim i As Long, j As Long, k As Long, l As Long, c As Integer
row = Cells(Rows.Count, 2).End(xlUp).row
k = 7
c = 1
For i = 7 To row Step 1
    If Join(Application.Transpose(Application.Transpose(Range(Cells(i, 1), Cells(i, 3)))), Chr(0)) <> Join(Application.Transpose(Application.Transpose(Range(Cells(i + 1, 1), Cells(i + 1, 3)))), Chr(0)) Then
      If i <> k Then
        For j = 1 To 3 Step 1
              Application.DisplayAlerts = False
              Range(Cells(i, j), Cells(k, j)).Merge
              Application.DisplayAlerts = True
        Next j
      End If
    Select Case c
        Case 0
            Range(Cells(k, 1), Cells(k, 3)).Interior.Color = xlNone
            c = 1
        Case 1
            For l = 0 To i - k Step 1
                Range(Cells(k + l, 1), Cells(k + l, 3)).Interior.Color = RGB(217, 225, 242)
            Next l
            c = 0
    End Select
    k = i + 1
    End If
Next i

Answer 2

Попробуйте:

Option Explicit

Sub test1()

    Dim LastColumn As Long, LastRow As Long, i As Long

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For i = 2 To LastRow Step 2
            .Range(Cells(i, 1), .Cells(i, LastColumn)).Interior.Color = vbGreen '<- You could change the color
        Next i

    End With

End Sub

До:

После:

Отредактированное решение:

Option Explicit

Sub test1()

    Dim rng As Range

    With ThisWorkbook.Worksheets("Sheet1")

        Set rng = .UsedRange

        .ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "Table1"
        .ListObjects("Table1").TableStyle = "TableStyleLight3"

    End With

End Sub

Результат: