Найдите, какие клетки имеют определенный цвет и перечислите их

Question

Я создаю упражнение на английском языке, где вы практикуете буквы и цифры, заставляя вас рисовать картинку, используя координаты сетки, которые я говорю вслух.В верхнем ряду есть буквы, а в левом столбце есть цифры, и, используя комбинацию обоих, вы можете указать, какой цвет, в какой ячейке.

Делая это в Excel, я рисовал пиксельные изображения вручную (распечатывать изображения и поля для рисования, затем окрашивать фоновые цвета в ячейках Excel), а затем выписывать ключ ответа (список черных ячеек в A, BC и т. д., красные ячейки в A, B, C и т. д.) вручную.Это было хорошо, но иногда приходит с ошибками.

Я хотел бы узнать способ перечисления, какие ячейки имеют определенный цвет фона в них.В конечном счете, было бы здорово, если бы я мог перечислить его, как в следующем примере:

• Черный
• A: 1, 2, 3, 4
• B: 4, 5, 6
• C: 4, 5, 6
• и т. Д.

Я слышал, что формулы не будут работать с Excel, и мне нужно будет использоватьмакрос, с которым у меня нет опыта.Любая помощь будет оценена!

Answer 1

Предполагая, что в вашей книге Excel есть хотя бы один лист с цветными ячейками (я буду называть этот лист "Sheet1") и один дополнительный, где отображается результат запроса, давайте назовем его "Sheet2", список кодаадрес цветных ячеек может выглядеть следующим образом:

Sub ColorIndex()

    Dim RNG         As Range    'the address of the cell you want to check
    Dim lnCol       As Long     'the column of the cell looked at
    Dim lnRow       As Long     'the row of the cell looked at
    Dim c           As Long     'the column on Sheet2 and...
    Dim r           As Long     'the row on Sheet2 where the address of the coloured cell is written to

    c = 1
    r = 1

    For lnCol = 1 To 100  'adjust if necessary, see below

        For lnRow = 1 To 100  'adjust if necessary, see below
        Set RNG = Worksheets("Sheet1").Cells(lnRow, lnCol)

            If RNG.Interior.ColorIndex = 1 Then
                Worksheets("Sheet2").Cells(r, c) = RNG.Address(ReferenceStyle:=xlR1C1) 'Address of the coloured cell on Sheet1 as Row x / Column y
                r = r + 1 'next match written in next row
                ElseIf RNG.Interior.ColorIndex = 2 Then
                    Worksheets("Sheet2").Cells(r, c+1) = RNG.Address(ReferenceStyle:=xlR1C1)
            End If

        Next lnRow

    Next lnCol

End Sub

Обратите внимание, что этот код проверяет только строки / столбцы с 1 по 100.Если у вас есть больший диапазон для проверки, измените число соответствующим образом.

Надеюсь, это поможет!