Есть ли способ зацикливания на ячейках определенного цвета в столбце?

Question

У меня есть столбец (столбец L) в электронной таблице, в которой есть много записей с некоторыми повторяющимися значениями в этом столбце.Каждая «группа» повторяющихся значений окрашивается в уникальный цвет.Поэтому в моем столбце много цветов, каждый из которых относится к одной группе повторяющихся значений.Я должен пройти через каждую «Группу», чтобы все клетки были окрашены в один и тот же цвет, и выполнить некоторые вычисления.Тем не менее, я не знаю, как перебрать все ячейки одного цвета в столбце.

Я был бы очень рад, если бы вы могли помочь мне с этим:)

Answer 1

Вы можете попробовать:

Option Explicit

Sub test()

    Dim LastRow As Long, i As Long, j As Long
    Dim arr As Variant

    With ThisWorkbook.Worksheets("Sheet1")

        'Find Last row of column L
        LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row

        'Set array starting from row 2 to LastRow of column L
        arr = .Range("L2:L" & LastRow)

        For i = LBound(arr) To UBound(arr)

            If .Range("L" & i).Interior.Pattern <> xlNone Then

                For j = LBound(arr) To UBound(arr)

                    If (.Range("L" & j).Interior.Pattern <> xlNone) And (i <> j) Then

                        If .Range("L" & i).Interior.Color = .Range("L" & j).Interior.Color Then

                            If .Range("N" & i).Value = "" Then
                                .Range("N" & i).Value = "Cell L" & i & " has the same background color with cell/s L" & j
                            Else
                                .Range("N" & i).Value = .Range("N" & i).Value & ", L" & j
                            End If

                        End If

                    End If

                Next j

            End If

        Next i

    End With

End Sub

Результаты: