Для каждого цикла не работает Поиск значения на одном листе и изменение значения на другом листе

Question

У меня есть список истинных и ложных значений на столбце 3 столбца А и список кодов на листе 2 Колонка А. Если значение на лист 3 A5 = True, тогда я хочу, чтобы значение на листе 2 A5 должно быть окрашено в красный цвет. И если значение на листе 3 A6 равно = True, то я хочу, чтобы значение на листе 2 A6 должно быть окрашено в красный цвет. И это должно двигаться вниз по колонке А на листе 2 и листе 3 до тех пор, пока данные не исчерпываются. Пока у меня есть это, чтобы работать для первой ячейки в столбце A, но не может заставить цикл For Each работать. Любая помощь будет принята с благодарностью.

Sub compare_cols() 

    Dim myRng As Range 
    Dim lastCell As Long 

    'Get the last row 
    Dim lastRow As Integer 
    lastRow = ActiveSheet.UsedRange.Rows.Count 

    'Debug.Print "Last Row is " & lastRow 

    Dim c As Range 
    Dim d As Range 

    Set c = Worksheets("Sheet3").Range("A5:25") 
    Set d = Worksheets("Sheet2").Range("A5:25") 


    Application.ScreenUpdating = False 

    For Each cell In c 
    For Each cell In d 

      If c.Value = True Then 
      d.Interior.Color = vbRed 
      End If 

Next 
Next 

    Application.ScreenUpdating = True 

End Sub 

Answer 1

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

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

Sub ColorOtherSheet() 
    Dim wsCheck As Worksheet 
    Dim wsColor As Worksheet 
    Dim rngLoop As Range 
    Dim rngCell As Range 

    Set wsCheck = Worksheets("Sheet3") 
    Set wsColor = Worksheets("Sheet2") 
    Set rngLoop = Intersect(wsCheck.UsedRange, wsCheck.Columns(1)) 

    For Each rngCell In rngLoop 
     If rngCell.Value = True Then 
      wsColor.Range(rngCell.Address).Interior.Color = vbRed 
     End If 
    Next rngCell 


End Sub