Как найти определенный цвет в диапазоне, а затем, если ячейка = "", установить значение 0 и сохранить тот же цвет в ячейке

Question

Я недавно начал играть с VBA, и я стараюсь изо всех сил, чтобы понять это, но безуспешно.

По сути, я хотел бы найти цвет в диапазоне, а затем, если ячейкапусто, я хотел бы поставить значение 0 и сохранить цвет.

Ниже приведен код, который я создал, но он не работает на "If PCell.Value = "" Then"

Sub ColorCell()
    PCell = RGB(255, 204, 204)

    range("A:F").Select

    For Each cell In Selection
        If cell.Interior.Color = PCell Then
            If PCell.Value = "" Then
                Set cell.Value = 0
            End If
         End If        
    Next
End Sub

Ниже приведен примеркак электронная таблица.

Буду очень признателен за вашу помощь.Я провел весь день, просматривая и пытаясь, но не повезло: (

Answer 1

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

Option Explicit

Sub test()

    Dim cell As Range, rng As Range
    Dim LastRow As Long

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row '<- Get the last row of column F to avoid looping all the column

        Set rng = .Range("A1:F" & LastRow) '<- Set the range from A1 to F last row

        For Each cell In rng

            If cell.Interior.Color = RGB(255, 204, 204) And cell.Value = "" Then
                cell.Value = 0
            End If

        Next cell

    End With

End Sub

Answer 2

Ваш код имеет некоторые проблемы:

• Set следует использовать только для объектов (например, Worksheets или Range)
• , вы тестируете PCell.Value вместо cell.Value

Вот рабочий код:

Sub ColorCell()
    PCell = RGB(255, 204, 204)

    Range("A:F").Select

    For Each cell In Selection
        If cell.Interior.Color = PCell Then
            If cell.Value = "" Then
                cell.Value = 0
            End If
         End If
    Next
End Sub

Answer 3

Заменить:

If PCell.Value = "" Then

на:

If Cell.Value = "" Then

Заменить:

Set cell.Value = 0

на:

cell.Value = 0

Также избегать Выбрать:

Sub ColorCell()
    Dim PCell As Variant, Intersection As Range, Cell As Range
    PCell = RGB(255, 204, 204)

    Set Intersection = Intersect(Range("A:F"), ActiveSheet.UsedRange)

    If Not Intersection Is Nothing Then
        For Each Cell In Intersection
            If Cell.Interior.Color = PCell Then
                If Cell.Value = "" Then
                    Cell.Value = 0
                End If
             End If
        Next
    End If
End Sub

(в коде могут быть и другие ошибки)

Answer 4

PCell не cell

Sub ColorCell()
    PCell = RGB(255, 204, 204)

    For Each cell In intersect(ActiveSheet.usedrange, range("A:F"))
        If cell.Interior.Color = PCell and cell.Value = "" Then
            cell.Value = 0
        End If        
    Next
End Sub