vba多列多条件求和

吓你一跳

求助：(多列多条件求和)一个sheet有20W行数据，跪求VBA。 根据sheet2的数值，筛选("单据类型”=16 店铺进货单  and  "库存方式"=02 通过型)的数据进行汇总 在sheet1表中输出(by:验收日,大类名称)维度的汇总数据(sum:预拣数,验收数,进货金额(未税)）。 [td]

[/td]

tanglf188

tanglf188

tanglf188 发表于 2024-5-6 14:22

按类汇总改动如下：
    Sele_str = "Select 大类名称,SUM(预拣数),SUM(验收数),SUM(进货金额（未税）) From [Sheet2$] Where 单据类型 = '16 店铺进货单'  And  库存方式 = '02 通过型' GROUP BY 大类名称;"

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.6
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     b = [{1,3,10,16,17,18}]
   
5.     With Sheets("Sheet2")
   
6.         r = .Cells(Rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r, 27)
   
8.     End With
   
9.     ReDim brr(1 To UBound(arr), 1 To 6)
   
10.     For i = 2 To UBound(arr)
    
11.         If Val(arr(i, 6)) = 16 Then
    
12.             If Val(arr(i, 25)) = 2 Then
    
13.                 s = CDate(arr(i, 3)) & "|" & arr(i, 10)
    
14.                 If Not d.exists(s) Then
    
15.                     m = m + 1
    
16.                     d(s) = m
    
17.                     brr(m, 1) = m
    
18.                     For x = 2 To UBound(b)
    
19.                         brr(m, x) = arr(i, b(x))
    
20.                     Next
    
21.                 Else
    
22.                     t = d(s)
    
23.                     For x = 4 To UBound(b)
    
24.                         brr(t, x) = brr(t, x) + arr(i, b(x))
    
25.                     Next
    
26.                 End If
    
27.             End If
    
28.         End If
    
29.     Next
    
30.     With Sheets("Sheet1")
    
31.         .UsedRange.Offset(1).Clear
    
32.         .Cells.Interior.ColorIndex = 0
    
33.         .[a1].Resize(1, 6).Interior.Color = 49407
    
34.         .[a2].Resize(m, 6).Value = brr
    
35.         m = m + 1
    
36.         .Cells(m + 1, 1) = "合计"
    
37.         .Cells(m + 1, 4).Resize(1, 3).FormulaR1C1 = "=SUM(R2C:R" & "[-1]C)"
    
38.         With .[a2].Resize(m, 6)
    
39.             .Borders.LineStyle = 1
    
40.             .HorizontalAlignment = xlCenter
    
41.             .VerticalAlignment = xlCenter
    
42.         End With
    
43.         .Cells(m + 1, 1).Resize(1, 6).Interior.Color = 16777062
    
44.     End With
    
45.     Set d = Nothing
    
46.     Application.ScreenUpdating = True
    
47.     MsgBox "OK！"
    
48. End Sub
    
49. 
    

复制代码

吓你一跳

ykcbf1100 发表于 2024-5-6 14:49
附件供参考。。。

谢谢大神！  追加一个：需要在sheet1生成的表格内增加1个字段(订货金额(未税)),订货金额(未税)=订购数(Ml列)*订购数(N列)

yanglinzi

不知是不是你要的结果

ykcbf1100

吓你一跳 发表于 2024-5-6 16:26
谢谢大神！  追加一个：需要在sheet1生成的表格内增加1个字段(订货金额(未税)),订货金额(未税)=订购数(Ml ...

改好了。。。

ykcbf1100

增加一列数据。

1. Sub ykcbf2()  '//2024.5.6
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     b = [{1,3,10,16,17,18}]
   
5.     With Sheets("Sheet2")
   
6.         r = .Cells(Rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r, 27)
   
8.     End With
   
9.     ReDim brr(1 To UBound(arr), 1 To 7)
   
10.     For i = 2 To UBound(arr)
    
11.         If Val(arr(i, 6)) = 16 Then
    
12.             If Val(arr(i, 25)) = 2 Then
    
13.                 s = CDate(arr(i, 3)) & "|" & arr(i, 10)
    
14.                 If Not d.exists(s) Then
    
15.                     m = m + 1
    
16.                     d(s) = m
    
17.                     brr(m, 1) = m
    
18.                     For x = 2 To UBound(b)
    
19.                         brr(m, x) = arr(i, b(x))
    
20.                     Next
    
21.                     brr(m, 7) = Application.Round(arr(i, 13) * arr(i, 14), 2)
    
22.                 Else
    
23.                     t = d(s)
    
24.                     For x = 4 To UBound(b)
    
25.                         brr(t, x) = brr(t, x) + arr(i, b(x))
    
26.                     Next
    
27.                     brr(t, 7) = brr(t, 7) + Application.Round(arr(i, 13) * arr(i, 14), 2)
    
28.                 End If
    
29.             End If
    
30.         End If
    
31.     Next
    
32.     With Sheets("Sheet1")
    
33.         .UsedRange.Offset(1).Clear
    
34.         .Cells.Interior.ColorIndex = 0
    
35.         .[a1].Resize(1, 7).Interior.Color = 49407
    
36.         .[a2].Resize(m, 7).Value = brr
    
37.         m = m + 1
    
38.         .Cells(m + 1, 1) = "合计"
    
39.         .Cells(m + 1, 4).Resize(1, 4).FormulaR1C1 = "=SUM(R2C:R" & "[-1]C)"
    
40.         With .[a2].Resize(m, 7)
    
41.             .Borders.LineStyle = 1
    
42.             .HorizontalAlignment = xlCenter
    
43.             .VerticalAlignment = xlCenter
    
44.         End With
    
45.         .Cells(m + 1, 1).Resize(1, 7).Interior.Color = 16777062
    
46.     End With
    
47.     Set d = Nothing
    
48.     Application.ScreenUpdating = True
    
49.     MsgBox "OK！"
    
50. End Sub
    
51. 
    

复制代码

吓你一跳

ykcbf1100 发表于 2024-5-6 19:15
改好了。。。

谢谢大神的帮助，