Sumproduct vba 宏如何停止循环过程

Question

我有一个工作代码，它将使用 2 个条件进行 sumproduct 计算，然后通过匹配将结果提供给字典，然后将它们粘贴为 1 output。

源数据的格式为 pivot 表，因此它已按 sumproduct 范围标准排序。 下面的示例。

我试图解决的问题是，代码将遍历整个 pivot 表，试图找到它找到的当前匹配项的下一个匹配项。 由于数据按 pivot 排序，一旦找到第一个不匹配项，就不会再有下一个匹配项。 我怎样才能在那一点停止代码以缩短循环？ 正是在代码中的这一点： (If UCase(arrI(i, 1)) = UCase(arrI(j, 1)) And arrI(i, 2) = arrI(j, 2) Then when code goes to next J/数据中的下一行）

Sub weighted_averagek()
 Dim sh As Worksheet, arrI As Variant, arrF As Variant, lastR As Long
 Dim i As Long, j As Long, pCount As Double, d As Object, pcount2 As Double, pcount3 As Double


  Set sh = ActiveSheet
  lastR = sh.Range("A" & Cells.Rows.Count).End(xlUp).Row
  arrI = sh.Range("A2:F" & lastR).Value
  ReDim arrF(1 To UBound(arrI, 1), 1 To 1)
  Set d = CreateObject("Scripting.Dictionary")

  For i = 1 To lastR - 1
    If Not d.Exists(UCase(arrI(i, 1) & arrI(i, 2))) Then
        For j = 1 To lastR - 1
            If UCase(arrI(i, 1)) = UCase(arrI(j, 1)) And arrI(i, 2) = arrI(j, 2) Then
                On Error GoTo missingrate
                pCount = pCount + (arrI(j, 6) * arrI(j, 5))
                pcount2 = pcount2 + arrI(j, 6)
                pcount3 = pCount / pcount2
missingrate:
            End If
        Next j
        d(UCase(arrI(i, 1) & arrI(i, 2))) = pcount3
        arrF(i, 1) = pcount3: pcount3 = 0: pCount = 0: pcount2 = 0
    Else
        arrF(i, 1) = d(UCase(arrI(i, 1) & arrI(i, 2)))
    End If
  Next
  sh.Range("G2").Resize(UBound(arrF, 1), 1).Value = arrF

End Sub

Answer 1

  Set d = CreateObject("Scripting.Dictionary")

  xi = 1
  yj = 1
  
  For i = xi To lastR - 1
    If Not d.Exists(UCase(arrI(i, 1) & arrI(i, 2))) Then
        For j = yj To lastR - 1
            If UCase(arrI(i, 1)) = UCase(arrI(j, 1)) And arrI(i, 2) = arrI(j, 2) Then
                             
                On Error GoTo missingrate
                pCount = pCount + (arrI(j, 6) * arrI(j, 5))
                pcount2 = pcount2 + arrI(j, 6)
                pcount3 = pCount / pcount2
missingrate:
                Else: If UCase(arrI(i, 1)) <> UCase(arrI(j, 1)) Or arrI(i, 2) <> arrI(j, 2) Then GoTo newmatchID

            End If
        Next j

newmatchID:
        
        d(UCase(arrI(i, 1) & arrI(i, 2))) = pcount3
        arrF(i, 1) = pcount3: pcount3 = 0: pCount = 0: pcount2 = 0
    Else
        arrF(i, 1) = d(UCase(arrI(i, 1) & arrI(i, 2)))
    End If
  yj = j
  xi = j