Как я могу получить значение ячейки, которая выделена каким-то цветом

Question

Может ли кто-нибудь помочь мне получить значение ячейки, которое выделено каким-то цветом. Ниже приведен код, где я могу получить адрес. но когда я изменяю на .cell.Value это всплывает ошибка ссылки на объект.

Sub ColorCellValue()
    Dim rCell As Range
    Dim lColor As Long
    Dim rColored As Range
    Dim rs As String
    Dim rng1 As Range
    'Dim EmailRange As Range
    'Select the color by name (8 possible)
    'vbBlack, vbBlue, vbGreen, vbCyan,
    'vbRed, vbMagenta, vbYellow, vbWhite
    'lColor = vbGreen

    'If you prefer, you can use the RGB function
    'to specify a color
    lColor = RGB(0, 255, 0)
    Set rng1 = ThisWorkbook.Worksheets("Sheet1").Range("B:B")
    Set rColored = Nothing
    For Each rCell In rng1
        If rCell.Interior.color = RGB(0, 255, 0) Then
            If rColored Is Nothing Then
                Set rColored = rCell
            Else
                Set rColored = Union(rColored, rCell)
            End If
        End If
    Next
    If rColored Is Nothing Then
        MsgBox "No cells match the color"
    Else
        rColored.Select
        MsgBox "Selected cells match the color:" & _
            vbCrLf & rColored.Address
    End If
    Set rCell = Nothing
    Set rColored = Nothing
End Sub

```

Answer 1

Ниже приведен рабочий и проверенный код. Требуется несколько зеленых - RGB (0,255,0) = 65280 - ячеек в столбце B и несколько записей в зеленых ячейках. Обратите внимание, что в поиске пропускается ячейка B1.

Sub ColorCellValue()

    Dim Rng1 As Range
    Dim rCell As Range
    Dim lColor As Long
    Dim rColored As Range
    Dim Txt As String
    Dim i As Long

    With ThisWorkbook.Worksheets("Sheet1")
        Set Rng1 = .Range(.Cells(2, 2), .Cells(.Rows.Count, "B").End(xlUp))
    End With

    lColor = 65280
    'If you prefer, you can use the RGB function to specify a color
    lColor = RGB(0, 255, 0)

    For Each rCell In Rng1
        If rCell.Interior.Color = lColor Then
            If rColored Is Nothing Then
                Set rColored = rCell
            Else
                Set rColored = Union(rColored, rCell)
            End If
        End If
    Next

    If rColored Is Nothing Then
        Txt = "No cells match the color."
    Else
        Txt = "Selected cells match the color:"
        For i = 1 To rColored.Areas.Count
            Txt = Txt & vbCr & rColored.Areas(i).Address _
                      & " = " & rColored.Areas(i).Cells(1).Value
        Next i
        rColored.Select
    End If
        MsgBox Txt, vbInformation, "Search report"
End Sub

Вы можете выполнить Debug.Print rColored.Address, но не сможете Debug.Print rColored.Value, если диапазон состоит из нескольких ячеек. , Поскольку диапазон не является смежным, вы, возможно, не сможете просмотреть его в каждой ячейке. Возможно, вам придется l oop через все его Areas, а затем For Each Cell in Area(i). Код - это ваш код по сути, который я только что немного разобрал - все в порядке. Он создает диапазон, который вы намереваетесь объединить. Следовательно, проблема должна заключаться в том, как вы пытаетесь получить доступ к диапазону. Мой код делает это. Таким образом, вы можете скопировать мои методы для использования в ваших собственных планах.