在行数据vba中对具有匹配条件的多列求和

Question

我想问一下excel vba。

我正在尝试合并工作表中的数据，其中包含截图（1）等数据。

我想要做的是合并具有行H（CTP.GRP）的唯一行的数据，并且将列M（标称）填充到列utlization＆amp;列中的另一个表。列P（IDR中的Mtm）将数据推向另一个工作表列市场值

我的代码只有一列，任何人都可以帮助代码如何将两列相加？

Sub ins_data()

Dim x As Variant

Dim y As Variant

Dim countDict As Variant

Dim a As Long



Set countDict = CreateObject("Scripting.Dictionary")



x = Sheets("Data").Range("A2").CurrentRegion



ReDim y(1 To UBound(x, 1), 1 To UBound(x, 2))

For a = 2 To UBound(x, 1)

cat1 = x(a, 8)

val1 = x(a, 16)

If countDict.exists(cat1) Then

countDict(cat1) = countDict(cat1) + val1

Else

countDict(cat1) = val1

End If

Next a



i = 1

For Each d In countDict

y(i, 2) = d

y(i, 8) = countDict(d)

i = i + 1

Next d



ThisWorkbook.Sheets("X").Range("B5").Resize(UBound(y), UBound(y, 2)).Value = y 

预期结果：

Answer 1

在OP的进一步澄清后编辑

你可以使用这段代码：

Option Explicit
Sub ins_data()
    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, 13)
        countDict2(x(a, 8)) = countDict(x(a, 8)) + x(a, 16)
    Next

    With ThisWorkbook.Sheets("X").Range("B5").Resize(countDict.Count) ‘ change “B5” to the actual worksheet “X” cell you want to start writing Sheets("Data")) column H unique values from
        .Value = Application.Transpose(countDict.Keys)
        .Offset(, 6).Value = Application.Transpose(countDict.Items) ‘ change “6” to your actual column offset from Sheets("X") referenced column (currently, “B”) you want to start writing Sheets("Data")) column M consolidated sum from
        .Offset(, 7).Value = Application.Transpose(countDict2.Items) ‘ change “7” to your actual column offset from Sheets("X") referenced column (currently, “B”) you want to start writing Sheets("Data")) column P consolidated sum from
    End With
End Sub