分别统计每天的交易类型的和

wuhaowu

麻烦老师根据A列日期和B列的交易类型，在表格2中分别显示每天上架和拣货的Q列数量的和.看下能不能实现。

ykcbf1100

排重求和。。。

ykcbf1100

排重求和。

1. Sub ykcbf()  '//2024.6.24
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     With Sheets("Sheet1")
   
7.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
8.         arr = .[a1].Resize(r, 26)
   
9.     End With
   
10.     ReDim brr(1 To UBound(arr), 1 To 3)
    
11.     On Error Resume Next
    
12.     For i = 2 To UBound(arr) - 2
    
13.         rq = Split(arr(i, 1))(0)
    
14.         s = rq & "|" & arr(i, 2)
    
15.         If Not d.exists(s) Then
    
16.             m = m + 1
    
17.             d(s) = m
    
18.             brr(m, 1) = rq
    
19.             brr(m, 2) = arr(i, 2)
    
20.             brr(m, 3) = arr(i, 17)
    
21.         Else
    
22.             r = d(s)
    
23.             brr(r, 3) = brr(r, 3) + arr(i, 17)
    
24.         End If
    
25.     Next
    
26.     With Sheets("Sheet2")
    
27.         .UsedRange.Offset(1).Clear
    
28.         With .[a2].Resize(m, 3)
    
29.             .Value = brr
    
30.             .Borders.LineStyle = 1
    
31.             .HorizontalAlignment = xlCenter
    
32.             .VerticalAlignment = xlCenter
    
33.         End With
    
34.         .[a2].Resize(m, 3).Sort .[a2], 1
    
35.     End With
    
36.     Set d = Nothing
    
37.     Application.ScreenUpdating = True
    
38.     MsgBox "OK！"
    
39. End Sub
    

复制代码

wuhaowu

ykcbf1100 发表于 2024-6-24 15:27
排重求和。。。

感谢老师的帮忙。

LIUZHU

参与下，效果如下

LIUZHU

JS代码，供参考

1. function 分类汇总(){
   
2.         let res=Sheets.Item("Sheet1").UsedRange.Value2.slice(1).reduce(function(res,[a,b,...x]){
   
3.                 if (b!="上架" && b!="拣货") return res;
   
4.                 let rq=this.Text(a,"yyyy-mm-dd"), key=rq + b;
   
5.                 return (res[key]=res[key] || (res[res.length]=[rq,b,0]))[2]+=x[14], res;
   
6.         }.bind(WorksheetFunction),[["日期","类型","和"]]);
   
7.         res.sort((a,b)=>res[0][0]==b[0] || a[0].localeCompare(b[0]) || b[1].localeCompare(a[1]));
   
8.         Sheets.Item("Sheet2").Range("a1").Resize(res.length, res[0].length).Value2=res;
   
9. }

复制代码

LIUZHU

附件，WPS打开测试，JS宏

LIUZHU

做了个排序，日期升序排列，统一日期内部，上架排在前面，拣货排在后面

wang-way

1. Sub SQL_QUERY_Demo()
   
2.     Set wb = Application.ThisWorkbook
   
3.     DataPath = wb.FullName
   
4.     Dim DATA_ENGINE As String
   
5.     Select Case Application.Version * 1
   
6.     Case Is <= 11
   
7.         DATA_ENGINE = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=YES;IMEX=2';Data Source="
   
8.     Case Is >= 12
   
9.         DATA_ENGINE = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=YES;IMEX=2'; Data Source= "
   
10.     End Select
    
11.     Set CNN = CreateObject("ADODB.Connection")
    
12.     Set rs = CreateObject("ADODB.RecordSet")
    
13.     CNN.Open DATA_ENGINE & DataPath
    
14.     erow = wb.Worksheets("Sheet1").Cells(Rows.Count, 17).End(xlUp).Row
    
15.     Sql = "select format(发生时刻,'m月d日') As 日期,交易类型 as 类型,sum(业务发生主数量) as 和 from [Sheet1$a1:z" & erow & "] where 交易类型 is not null Group by 发生时刻,交易类型"
    
16.     Set rs = CNN.Execute(Sql)
    
17.     wb.Worksheets("Sheet2").Range("A2").CopyFromRecordset rs
    
18.     For j = 1 To rs.Fields.Count
    
19.         Debug.Print rs.Fields(j - 1).Name, wb.Worksheets("Sheet2").Cells(1, j).Address
    
20.         wb.Worksheets("Sheet2").Cells(1, j).Value = rs.Fields(j - 1).Name
    
21.     Next j
    
22.     rs.Close
    
23.     CNN.Close
    
24. End Sub
    

复制代码

usedrange

1. Sub t()
   
2.     Dim dic, d, m%, arr, brr, i%, k, t, r%
   
3.     Set dic = CreateObject("scripting.dictionary")
   
4.     With Sheet1
   
5.         m = .[a1].End(4).Row
   
6.         arr = .Range("a2:q" & m - 2)
   
7.     End With
   
8.     For i = 1 To UBound(arr)
   
9.         d = Split(arr(i, 1))
   
10.         dic(d(0) & "|" & arr(i, 2)) = dic(d(0) & "|" & arr(i, 2)) + arr(i, 17)
    
11.     Next i
    
12.     ReDim brr(1 To dic.Count, 1 To 3)
    
13.     r = 1
    
14.     For Each k In dic.keys
    
15.         t = Split(k, "|")
    
16.         brr(r, 1) = t(0)
    
17.         brr(r, 2) = t(1)
    
18.         brr(r, 3) = dic(k)
    
19.         r = r + 1
    
20.     Next k
    
21.     Sheet2.[a2].Resize(UBound(brr), 3) = brr
    
22. End Sub

复制代码