Question

我是VBA编程的新手，我正在寻找一种搜索大约2,000到3,000行的方法来比较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`

老实说，这超出了我目前的VBA技能水平，我想不出任何方法可以使用Macro录音机来提供帮助。我想知道是否有任何方法可以优化此代码以更快地运行，并且还有一种方法可以调整它以写出具有差异量的所有ID号，而不是单独显示每个ID号的消息框。

谢谢！

Answer 1

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

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

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

enter image description here

Answer 2

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

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

.Find比通过所有数据行的内循环快得多（大约一周左右的人测试并找到了比循环快1000倍的内容）。不幸的是，这种方法会在您的不匹配列表中留下重复的ID，因为它会遍历整个列表，查找每个对并发现它们都不匹配：

ID          Value
ABC         1
BCD         6
ABC         2

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

^{注意：在撰写此答案时未测试任何代码。可能存在拼写错误}

VBA搜索相应的行并比较值

2 个答案: