文档库

最新最全的文档下载
当前位置:文档库 > 多条件查询结果相加并且赋值处理

多条件查询结果相加并且赋值处理

'
'该VB作用为,当三个条件同时符合某个数值的时候,将其中符合该条件的另外两个数值进行SUBTOTAL
'
Sub justtest()
Dim dic, i&, arr1, arr2, arr, str1$, str2$
Set dic = CreateObject("scripting.dictionary") '建立字典dic
For i = 2 To Cells(Rows.Count, 4).End(3).Row
str1 = Cells(i, 4).Value & vbTab & Cells(i, 6).Value & vbTab & Cells(i, 8).Value '将查询条件相加成某一个使用TAB分隔的条件字符
str2 = Join(Application.Transpose(Application.Transpose(Cells(i, 1).Resize(1, 10))), vbTab) '将查询行的所有数值转换为字符相加成一个使用TAB分隔的字符
If dic.Exists(str1) Then '判断当字典中含有条件字符str1
arr = Split(str2, vbTab) '如果字典内含该条件,则依据TAB分隔查询行字符,并赋值给数组arr
arr(6) = Val(Split(dic(str1), vbTab)(6)) + Val(arr(6)) '符合条件的数组第7项进行相加 arr(6)
arr(8) = Val(Split(dic(str1), vbTab)(8)) + Val(arr(8)) '符合条件的数组第9项进行相加 arr(8)
dic(str1) = Join(arr, vbTab) '将新的数组arr添加到字典dic(str1)中
Else: dic.Add str1, str2
End If
Next
arr1 = dic.items
For i = LBound(arr1) To UBound(arr1)
If Val(Split(arr1(i), vbTab)(6)) < 0 Or Val(Split(arr1(i), vbTab)(8)) < 0 Then '判断数组arr1的第7项或第9想是否小于0
arr3 = Split(arr1(i), vbTab)
dic.Remove arr3(3) & vbTab & arr3(5) & vbTab & arr3(7)
End If
Next
With Sheets("多条件汇总数量和金额新表")
.Cells.Clear
.Range("a1:j1").Value = Range("a1:j1").Value
If dic.Count > 0 Then
arr2 = dic.items
For i = 2 To dic.Count + 1
.Cells(i, 1).Resize(1, 10) = Application.Transpose(Application.Transpose(Split(arr2(i - 2), vbTab))) '对行号i,从列A到列J进行赋值
Next i
End If
.Range("a:j").EntireColumn.AutoFit
.Select
End With
Erase arr
Erase arr1
Erase arr2
Set dic = Nothing
End Sub

Private Sub CommandButton1_Click()
justtest
End Sub