Использование сопоставления для окрашивания ячейки, если она не найдена при перемещении сопоставленной ячейки

Question

Я пытаюсь настроить макрос для запуска Application.Match, чтобы переместить одну ячейку (столбец A), если она соответствует ячейке в столбце P, в средний столбец H. Он сравнивает проекты месяц за месяцем, поэтому я нужно увидеть, если какие-либо были отменены или какие-либо новые проекты произошли. Но, если он не совпадает, либо переместите его в конец списка, либо выделите его, чтобы я мог вручную переместить его. Очень новый для Excel VBA, поэтому любая помощь очень ценится!

Я нашел большую часть кода с этого форума: Сравните столбец A со столбцом C, Переместить соответствующую ячейку из местоположения в столбец B в соответствующей строке

Так что спасибо @ Samatar.

Sub Sorter()

Dim rng1 As Range, rng2 As Range, rng3 As Range, i As Long, iL As Long, var As Variant

iL = Sheets("Comparison").Range("P" & Rows.Count).End(xlUp).Row
For i = 2 To iL
     Set rng1 = Sheets("Comparison").Range("P" & i)
     Set rng2 = Sheets("Comparison").Range("A:A")
     Set rng3 = Sheets("Comparison").Range("H:H")

     var = Application.Match(rng1.Value, rng2, 1)

     If Not IsError(Application.Match(rng1.Value, rng2, 0)) Then
          bln = True
          If bln = True Then
                 rng1.Copy
                 rng1.Offset(0, -8).PasteSpecial
                 var2 = Application.Match(rng2.Value2, rng3, 1)
                 If Not IsError(Application.Match(rng2.Value2, rng3, 0)) Then
                    bln = False
                    If bln = False Then
                        rng2.Interior.Color = RBG(255, 255, 0)
                    End If
                 End If

                Set rng1 = Nothing
                Set rng2 = Nothing
                Set rng3 = Nothing
           End If
      End If

 Next i

End Sub

Answer 1

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

Sub Sorter()

Dim iL As Long
Dim i As Long

    With Sheets("Comparison")

        iL = .Range("A" & Rows.Count).End(xlUp).Row

        For i = 2 To iL
            If WorksheetFunction.CountIf(.Range("P:P"), .Range("A" & i)) = 0 Then
                .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1) = .Range("A" & i)
                .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Interior.Color = RGB(255,255,0)
            Else
                .Range("H" & i) = .Range("A" & i)
            End If
            .Range("A" & i) = ""
        Next i
        .Range("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp '<- added these for formatting purposes, they can be deleted if you don't want them
        .Range("H:H").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp '<- added these for formatting purposes, they can be deleted if you don't want them

    End With

End Sub