加载一个总和重复键的VBA词典

我想用字典来执行查找。由于我查找的数据有重复，因此我得到了一些不正确的结果。下面是我查找的“公式版”：加载一个总和重复键的VBA词典

=IFERROR(VLOOKUP([@[Contract]],'Subs Summary'!I:P,8,FALSE),0)

的问题是，在替补总结工作，“合同”（I栏）可以有多个行具有相同的合同（和Vloookup只拉回到找到合同的第一行）。我想通过字典执行查找，当发生重复契约时，对列P中的值进行求和（而不是仅检索第一个实例/行）。

下面是我的字典加载和查询当前代码：

Dim x, x2, y, y2() 
Dim i As Long 
Dim dict As Object 
Dim LastRowTwo As Long, shtOrders As Worksheet, shtReport As Worksheet 

Set shtOrders = Worksheets("Orders") 
Set shtReport = Worksheets("Subs Summary") 
Set dict = CreateObject("Scripting.Dictionary") 

'get the lookup dictionary from Report 
With shtReport 
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row 
    x = .Range("I2:I" & lastRow).Value 
    x2 = .Range("P2:P" & lastRow).Value 
    For i = 1 To UBound(x, 1) 
     dict.Item(x(i, 1)) = x2(i, 1) 
    Next i 
End With 

'map the values 
With shtOrders 
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row 
    y = .Range("C2:C" & lastRow).Value  'looks up to this range 
    ReDim y2(1 To UBound(y, 1), 1 To 1)  '<< size the output array 
    For i = 1 To UBound(y, 1) 
     If dict.exists(y(i, 1)) Then 
      y2(i, 1) = dict(y(i, 1)) 
     Else 
      y2(i, 1) = "0" 
     End If 
    Next i 
    .Range("CM2:CM" & lastRow).Value = y2  '<< place the output on the sheet 
End With

此代码（我相信）被正确地执行VLOOKUP，但没有在所有的处理重复。我试图编码一个检查，如果键（在列I中）已经存在于字典中，并且如果是这样，则将列P中的行值与该合同/键的已有列P值相加。在查找页面中，密钥/合约经常有4行（Subs Summary）。

任何输入都非常感谢 - 我对字典和VBA一般都比较陌生，所以可能是我现有的代码有另一个问题/效率低下。它确实运行没有错误，并根据我所知可以检索除重复项之外的正确值。

干杯！

来源

2017-09-14 RugsKid

问题标题是不明确的：一个字典**通过定义**不会有重复的密钥。但是，我明白你的意思。你不想要一个SUMIF吗？ –

@ Mat'sMug你是完全正确的 - 任何建议更合适的标题？是的，我认为SUMIF（针对我所描述的情况），但我不清楚“检查合约是否重复应该发生”以及使用什么语法 – RugsKid

了解SUMIF和SUMIFS是如何工作的。你可以不用任何代码就可以做到 –

我能适应我上面贴通过调节码/添加此部分：

If Not dict.exists(x(i, 1)) Then 
    dict.Add x(i, 1), x2(i, 1) 
Else 
    dict.Item(x(i, 1)) = CDbl(dict.Item(x(i, 1))) + CDbl(x2(i, 1)) 
End If 
Next i

SUMIFS最终没有工作，因为有两个“订单”工作表的复印件，以及“替补摘要“工作表。也许有一种方法可以仅使用SUMIFS来完成此操作，但其中的代码（如下所示）完全适用，效果很好。

Dim x, x2, y, y2() 
Dim i As Long 
Dim dict As Object 
Dim LastRowTwo As Long, shtOrders As Worksheet, shtReport As Worksheet 

Set shtOrders = Worksheets("Orders") 
Set shtReport = Worksheets("Subs Summary") 
Set dict = CreateObject("Scripting.Dictionary") 

'get the lookup dictionary from Report 
With shtReport 
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row 
    x = .Range("I2:I" & lastRow).Value 
    x2 = .Range("P2:P" & lastRow).Value 
    For i = 1 To UBound(x, 1) 

If Not dict.exists(x(i, 1)) Then 
    dict.Add x(i, 1), x2(i, 1) 
Else 
    dict.Item(x(i, 1)) = CDbl(dict.Item(x(i, 1))) + CDbl(x2(i, 1)) 
End If 
Next i 

End With 

'map the values 
With shtOrders 
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row 
    y = .Range("C2:C" & lastRow).Value 'looks up to this range 
    ReDim y2(1 To UBound(y, 1), 1 To 1) '<< size the output array 
    For i = 1 To UBound(y, 1) 
     If dict.exists(y(i, 1)) Then 
      y2(i, 1) = dict(y(i, 1)) 
     Else 
      y2(i, 1) = "0" 
     End If

谢谢大家！下一个I .Range（ “CM2：CM” & LASTROW）。价值= Y2'< <就位在片结束的输出与

来源

2017-09-14 20:10:43 RugsKid

加载一个总和重复键的VBA词典

回答

相关问题