Условное форматирование всего листа с помощью макроса

Question

Вам нужна ваша помощь. В моей таблице есть макрос, который при активированном тесте, чтобы увидеть, является ли цвет ячейки во всем наборе данных розовым. Если кто-то найден, то кулачная клетка отмечена розовой, предупреждая меня о том, что в этом конкретном ряду есть розовая клетка где-то.

Как только я обратил внимание на розовую ячейку, я снова ее промаркирую и перейду к следующему.

Что мне нужно добавить к рабочему коду ниже тест, чтобы увидеть, если нет гвоздики .. есть ..

если ячейка A9 розовое это значит где-то в строке 9 есть розовый. Мне нужно проверить, все ли он там, если не сделать A9 прозрачным.

Приведенный ниже код является один, который отмечает A9 розовый (как на примере выше

Код:.

Sub pink() 
Dim rcell As Range 
For Each rcell In Range(Cells(1, 1), Cells(1, ActiveSheet.UsedRange.Columns.Count)) 
    If rcell.Interior.ColorIndex = 38 Then 
     Cells(ActiveSheet.UsedRange.Rows.Count, rcell.Column).Select 
      Do Until ActiveCell.Interior.ColorIndex = rcell.Interior.ColorIndex 
       ActiveCell.Offset(-1).Select 
      Loop 
      If ActiveCell.Row = rcell.Row Then rcell.Interior.ColorIndex = xlNone 
    End If 
Next rcell 
For Each rcell In ActiveSheet.UsedRange 
    If rcell.Interior.ColorIndex = 38 Then 
     Cells(rcell.Row, 1).Interior.ColorIndex = 38 
    End If 
Next rcell 
End Sub 

пробежать сценарию:

Row 1 являются заголовки и являются исключение, колонка A - столбец, где вещи становятся заметными розовыми.

B8 является розовым, поэтому, когда макрос работает, A8 становится розовым, D14 является розовым и, таким образом, A14 становится розовым, A18 является розовым но в ряду 18 больше нет генов, таким образом, A18 становится прозрачным и т. д. и т. д.

любые предложения?

Answer 1

Вы можете выполнить прозрачную процедуру ниже. Это сделает ячейки в column A прозрачными, если в этой строке нет розовых клеток.

Sub transparent() 

    Dim lastRow As Long, rcell As Range, blnRed As Boolean 
    lastRow = ActiveSheet.UsedRange.Rows.Count 

    For i = 1 To lastRow 
     If Cells(i, 1).Interior.ColorIndex = 38 Then 
      For Each rcell In Range(Cells(i, 2), Cells(i, ActiveSheet.UsedRange.Columns.Count)) 
       If rcell.Interior.ColorIndex = 38 Then 
        blnRed = True 
        Exit For 
       Else 
        blnRed = False 
       End If 
      Next 

      If blnRed = False Then 
       Cells(i, 1).Interior.Pattern = xlNone 
      End If 
     End If 
    Next 
End Sub