使用行vba中的条件对多列进行求和

Question

如何整合排H＆amp; L然后在N和N列中求和值Q'

我的数据截图：

从数据填充到另一张表格，我称之为表格＆＃34; X＆＃34;。

预期结果

我使用字典，它只能占用1个密钥和1个值（我从上一个问题得到这个代码）并且不符合我的期望：

Sub testttt()
Dim countDict As Object, countDict2 As Object
Set countDict = CreateObject("Scripting.Dictionary")
Set countDict2 = CreateObject("Scripting.Dictionary")

Dim x() As Variant
x = Sheets("Data").Range("A2").CurrentRegion.Value2

Dim a As Long
For a = 2 To UBound(x, 1)
    countDict(x(a, 8)) = countDict(x(a, 8)) + x(a, 14)
    countDict2(x(a, 12)) = countDict(x(a, 8))
Next

With ThisWorkbook.Sheets("X").Range("B5").Resize(countDict.Count)
    .Offset(, 1).Value = Application.Transpose(countDict.Keys)
    .Offset(, 4).Value = Application.Transpose(countDict2.Keys)
    .Offset(, 5).Value = Application.Transpose(countDict.Items)
    .Offset(, 6).Value = Application.Transpose(countDict2.Items)
End With
End Sub

Answer 1

将密钥构建为所需值的组合，然后使用尽可能多的字典，因为您需要共享相同的密钥并将每个值作为项目

Sub testttt()
    Dim dictH As Object, dictSumQ  As Object, dictSumN As Object, dictA As Object, dictI As Object, dictL As Object, dictR As Object
    Set dictA = CreateObject("Scripting.Dictionary")
    Set dictH = CreateObject("Scripting.Dictionary")
    Set dictI = CreateObject("Scripting.Dictionary")
    Set dictL = CreateObject("Scripting.Dictionary")
    Set dictR = CreateObject("Scripting.Dictionary")
    Set dictSumN = CreateObject("Scripting.Dictionary")
    Set dictSumQ = CreateObject("Scripting.Dictionary")

    Dim x() As Variant
    x = Sheets("Data").Range("A2").CurrentRegion.Value2

    Dim a As Long
    Dim key As Variant

    For a = 2 To UBound(x, 1)
        key = x(a, 8) & "|" & x(a, 12) & "|"
        dictA(key) = x(a, 1)
        dictH(key) = x(a, 8)
        dictI(key) = x(a, 9)
        dictL(key) = x(a, 12)
        dictR(key) = x(a, 18)
        dictSumN(key) = dictSumN(key) + x(a, 14)
        dictSumQ(key) = dictSumQ(key) + x(a, 17)
    Next
    With ThisWorkbook.Sheets("X1").Range("A5").Resize(dictSumN.Count)
        .Offset(, 1).Value = Application.Transpose(dictA.Items)
        .Offset(, 2).Value = Application.Transpose(dictH.Items)
        .Offset(, 3).Value = Application.Transpose(dictI.Items)
        .Offset(, 4).Value = Application.Transpose(dictR.Items)
        .Offset(, 5).Value = Application.Transpose(dictL.Items)
        .Offset(, 6).Value = Application.Transpose(dictSumN.Items)
        .Offset(, 7).Value = Application.Transpose(dictSumQ.Items)
    End With
End Sub