关于字典键值用Split函数分割的问题.

讲古派

草稿表 - 副本.zip (23.02 KB, 下载次数: 16)

2024-5-17 12:59 上传

点击文件名下载附件

    祥见附件

taller

讲古派

我以为要过两天才有答案, 没想到这么快就被你解出来了,  实测可用.  非常感谢.

Qs18

Sub 系统数据分析()
Dim crr, brr
    Set d = CreateObject("Scripting.Dictionary") '设置d为字典对象
    arr = Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        d(arr(i, 1) & "/" & arr(i, 2)) = d(arr(i, 1) & "/" & arr(i, 2)) + arr(i, 3)
    Next
    endrow = Sheets("系统数据分析结果").Range("a1000000").End(xlUp).Row + 1
    Sheets("系统数据分析结果").Cells(endrow, 1).Resize(d.Count, 1) = InputBox("请输入月份")
   
    crr = d.Keys
    ReDim brr(0 To UBound(crr), 0 To 1)
    For j = 0 To UBound(crr)
        brr(j, 0) = Split(crr(j), "/")(0)
        brr(j, 1) = Split(crr(j), "/")(1)
    Next
    Sheets("系统数据分析结果").Cells(endrow, 2).Resize(d.Count, 2) = brr
    Sheets("系统数据分析结果").Cells(endrow, 4).Resize(d.Count, 1) = Application.Transpose(d.items)
   
   
    Sheets("系统数据分析结果").Select
End Sub

LIUZHU

这个效果吗？看看

LIUZHU

JSA代码，供参考

1. function 分析(){
   
2.         let arr=Sheets.Item("系统数据导出").Range("a1").CurrentRegion.Value2;
   
3.         let obj=arr.slice(1).reduce((obj,[a,b,c])=>{
   
4.                 let temp=obj[a+b]=obj[a+b] || [a,b,0];
   
5.                 temp[2]+=c;
   
6.                 return obj;
   
7.         },{"表头":["结算类型","操作类型","结算金额"]});
   
8.         let res=Object.values(obj);
   
9.         Sheets.Item("系统数据分析结果").Activate();
   
10.         Range("h7").Resize(res.length,res[0].length).Value2=res;
    
11. }

复制代码

LIUZHU

附件在此，WPS审核

ykcbf1100

新写一个，字典嵌套

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.17
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("系统数据导出")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 3)
   
6.     End With
   
7.     yf = Application.InputBox("请输入月份：", "月份", "5月")
   
8.     For i = 2 To UBound(arr)
   
9.         s = arr(i, 1): ss = arr(i, 2)
   
10.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
11.         d(s)(ss) = d(s)(ss) + arr(i, 3)
    
12.     Next
    
13.     ReDim brr(1 To 1000, 1 To 4)
    
14.     For Each k In d.keys
    
15.         For Each kk In d(k).keys
    
16.             m = m + 1
    
17.             brr(m, 1) = yf
    
18.             brr(m, 2) = k
    
19.             brr(m, 3) = kk
    
20.             brr(m, 4) = d(k)(kk)
    
21.         Next
    
22.     Next
    
23.     With Sheets("系统数据分析结果")
    
24.         .[a8:d10000] = ""
    
25.         .Columns(1).NumberFormatLocal = "@"
    
26.         .[a8].Resize(m, 4) = brr
    
27.     End With
    
28.     Set d = Nothing
    
29.     MsgBox "OK！"
    
30. End Sub
    

复制代码

讲古派

LIUZHU 发表于 2024-5-17 15:11
JSA代码，供参考

这个有点高级.