VBA 多条件求和

Sub test()

Dim oDic As Object

Dim i As Long

Dim Dsum

Dim Arr

Arr = Range("A1:C" &[A65536].End(xlUp).Row)

Set oDic = CreateObject("Scripting.Dictionary")

With oDic

For i = 1 To UBound(Arr)

oDic(Format(Arr(i, 1), "yy-m-d") &"@@" &Arr(i, 2)) = oDic(Format(Arr(i, 1), "yy-m-d") &"@@" &Arr(i, 2)) + Arr(i, 3)

Next

End With

Dsum = oDic(Format("2010-8-5", "yy-m-d") &"@@" &"A") '"2010-8-5"这个是你求和的日期，"A"是名称根据需要自己设置

End Sub

1、首先，在Excel中新建数据表格。

2、然后，在电脑键盘上按快捷键Alt+F11，从而Excel进入vba界面。

3、接着，在Excel的vba界面依次点击插入——模块，从而进入代码编写的界面。

4、最后，在代码编写的界面输入代码：

sub合计20()

Dim a%

Do Until Sheet2. Cells (a, 2)=""

Sheet2. Cells(2, 3)= Sheet2. Cells (2, 3)+ Sheet2. Cells (a, 2)

a=a+1

End sub

插入控件，将控件制定宏为刚才写的代码即可。

这种情况用字典法最合适

Sub test()

arr = Sheet2.Range("A1:E" & Sheet2.[a65536].End(xlUp).Row) 'Sheet2数据存入数组

Set d1 = CreateObject("Scripting.Dictionary") '外发字典

Set d2 = CreateObject("Scripting.Dictionary") '返回字典

Set d3 = CreateObject("Scripting.Dictionary") '生产字典

For i = 1 To UBound(arr)

d1(arr(i, 1) & arr(i, 2)) = d1(arr(i, 1) & arr(i, 2)) + arr(i, 3)

d2(arr(i, 1) & arr(i, 2)) = d1(arr(i, 1) & arr(i, 2)) + arr(i, 4)

d3(arr(i, 1) & arr(i, 2)) = d1(arr(i, 1) & arr(i, 2)) + arr(i, 5)

Next

For i = 2 To [iv3].End(xlToLeft) Step 4

For j = 5 To [a65536].End(xlUp).Row

Cells(j, i) = d1(Cells(j, 1).Value & Cells(3, i).Value)

Cells(j, i + 1) = d2(Cells(j, 1).Value & Cells(3, i).Value)

Cells(j, i + 3) = d3(Cells(j, 1).Value & Cells(3, i).Value)

Next

Next

End Sub

---