VBA搜索对应的行并比较值

我是VBA编程新手，我正在寻找一种方法来搜索大约2000到3000行的范围，以比较ID号匹配的数量，并生成一个消息框，如果存在数量不匹配的匹配ID号，则显示ID号。数据中有2个匹配的ID号

我已经找到并修改了这个代码

`Dim rng1 As Range, rng2 As Range, rngName As Range, i As Integer, j As Integer
    For i = 1 To Sheets("Sheet1 (2)").Range("q" & Rows.Count).End(xlUp).Row
        Set rng1 = Sheets("Sheet1 (2)").Range("q" & i)
        For j = 1 To Sheets("Sheet1 (2)").Range("q" & Rows.Count).End(xlUp).Row
            Set rng2 = Sheets("Sheet1 (2)").Range("q" & j)
            Set rngName = Sheets("Sheet1 (2)").Range("q" & j)
            If rng1.Value = rng2.Value Then
               If rng1.Offset(0, 2).Value <> rng2.Offset(0, 2).Value Then
               MsgBox ("Not equal " & rng1 & " Net " & rng1.Offset(0, 2) - rng2.Offset(0, 2))
               Exit For
               End If
            End If

        Set rng2 = Nothing
    Next j
    Set rng1 = Nothing
 Next i`

`Dim rng1作为范围，rng2作为范围，rngName作为范围，i作为整数，j作为整数
对于i=1到图纸（“图纸1（2）”）。范围（“q”和行数。计数）。结束（xlUp）。行
设置rng1=图纸（“图纸1（2）”）。范围（“q”和i）
对于j=1到图纸（“图纸1（2）”）。范围（“q”和行数。计数）。结束（xlUp）。行
设置rng2=图纸（“图纸1（2）”）。范围（“q”和“j”）
设置rngName=图纸（“图纸1（2）”）。范围（“q”和“j”）
如果rng1.Value=rng2.Value，则
如果rng1.Offset（0，2）.值为rng2.Offset（0，2）.值，则
MsgBox（“不相等”&rng1&“净”&rng1.Offset（0,2）-rng2.Offset（0,2））
退出
如果结束
如果结束
设置rng2=无
下一个j
设置rng1=无
接下来我`

老实说，这超出了我目前在VBA方面的技能水平，我想不出任何方法来使用宏记录器来帮助我。我想知道是否有任何方法可以优化此代码以更快地运行，以及是否有一种方法可以使其适应，以写出所有具有差异量的ID号，而不是单独显示每个ID号的消息框

---

谢谢

如果最多只能有两个匹配项，则可以使用公式执行此操作：例如，如果ID在ColA中，金额在ColB中，则在ColC中输入

=IFERROR(VLOOKUP(A2,A3:B$9,2,FALSE)-B2,0) 

然后填好。如果没有不匹配（或没有匹配Id），结果将为零，否则将是两个金额之间的差异

如果数据已排序（假设Q列中有ID，R列中有数量）：

它将循环到ABC/1，找到ABC/2，然后在循环的后面找到ABC/2，发现它与ABC/1不匹配，并报告两者。如果可以对数据进行排序，则第一个选项中的排序数据将工作得更好

---

注意：在编写此答案时未测试任何代码。可能有拼写错误需要解决

您的问题让我感到困惑。如果找到了两个匹配的ID，并且这些ID的数量不相等，则表示希望显示ID号，然后表示数据中有两个匹配的ID号。如果你知道有一个ID出现两次，这是一个不同的解决方案，如果有多个ID出现不止一次。对不起，这不是很清楚。每个ID在数据中出现2次。两个数量值应彼此相等。我在寻找ID1第一次和第二次出现的数量之间的差异，若它们不相等，那个就更清楚了。数据是否按ID排序？如果是这样的话，这是一个快速循环，通过观察这一行和下一行。如果数据未排序，则使用

循环遍历所有内容。查找
以查找匹配项，然后比较数量。谢谢！我能够修改你的代码，而且效果很好。通过像你建议的那样对数据进行排序，我能够显著地缩短处理时间。我很高兴这是有帮助的。检查帮助您解决问题的答案有助于整个社区。
Dim ErrorList as String
With Sheets("Sheet1 (2)")
  For i = 1 To .Range("q" & Rows.Count).End(xlUp).Row step 2
    if .range("R" & i).value <> .range("R" & i+1) then
      ErrorList = ErrorList & "ID: " & .range("Q" & I) & "  Net: " & _
                  .range("R" & i).value - .range("R" & i+1).value & vbcrlf
    end if
  next
end with
'do something like MsgBox with ErrorList

Dim ErrorList as String
With Sheets("Sheet1 (2)")
  For i = 1 To .Range("q" & Rows.Count).End(xlUp).Row
  'assume .range("q"
    Set Rng = .Range("q:q").Find(what:=.range("q" & i), LookIn:=xlValues, _
              lookat:=xlPart, MatchCase:=False)
    If .range("Q" & I).value <> rng.cells(1,1).value then 
      ErrorList = ErrorList & "ID: " & .range("Q" & I) & "  Net: " & _
                  .range("R" & i).value - .range("R" & i+1).value & vbcrlf
    end if
  next
end with
'do something like MsgBox with ErrorList

ID          Value
ABC         1
BCD         6
ABC         2