时间戳

首页 > 解决方案 > 如果在移动匹配的单元格时找不到，则使用匹配为单元格着色

excel - 如果在移动匹配的单元格时找不到，则使用匹配为单元格着色

问题描述

我正在尝试设置一个宏来运行 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

标签： excelvba

解决方案

我用你的数据结构的一个小重建来测试这个，但你可能会使用一个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

推荐阅读