|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub 条件求和()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "数据源为空!": End
ar = .Range("a1:m" & r)
End With
With Sheets("Sheet2")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 2 Then MsgBox "请先录入目标表系列号!": End
.Range("f2:n" & rs) = Empty
br = .Range("a1:n" & rs)
For i = 2 To UBound(br)
If br(i, 1) <> "" Then
d(br(i, 1)) = i
End If
Next i
For i = 2 To UBound(br)
xh = d(ar(i, 1))
If xh <> "" Then
For j = 5 To UBound(ar, 2)
br(xh, j + 1) = br(xh, j + 1) + ar(i, j)
Next j
End If
Next i
.Range("a1:n" & rs) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|