求助VBA的汇总数据的问题

Qs18

试一下.......

LIUZHU

参与下，效果

LIUZHU

JS代码，供参考

1. function 统计(){
   
2.         let res=Range("a1").CurrentRegion.Value2.slice(1).reduce((res,[a,b])=>{
   
3.                 return (res[a+b]=res[a+b] || (res[res.length]=[a,b,0]))[2]++, res;
   
4.         },[["表箱类型","表箱型号","表箱数量"]]);
   
5.         Range("d1").Resize(res.length, 3).Value2=res;
   
6. }

复制代码

LIUZHU

附件，请审核，WPS打开测试

ykcbf1100

参与一下，排重统计

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.27
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Range("a1").CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To 3)
   
7.     For i = 2 To UBound(arr)
   
8.         s = arr(i, 1) & "|" & arr(i, 2)
   
9.         If Not d.Exists(s) Then
   
10.             m = m + 1
    
11.             d(s) = m
    
12.             brr(m, 1) = arr(i, 1)
    
13.             brr(m, 2) = arr(i, 2)
    
14.             brr(m, 3) = 1
    
15.         Else
    
16.             r = d(s)
    
17.             brr(r, 3) = brr(r, 3) + 1
    
18.         End If
    
19.     Next
    
20.     [d2:f10000].ClearContents
    
21.     [d2].Resize(m, 3) = brr
    
22.     [d2].Resize(m, 3).Borders.LineStyle = 1
    
23.     Set d = Nothing
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "OK！"
    
26. End Sub
    
27. 
    

复制代码

grf1973

发现d[x]后直接x=x[0]+","+x[1]了。。。。。。

wang-way

LIUZHU 发表于 2024-6-27 16:01
JS代码，供参考

  够简单，要不琢磨一遍真看不懂

听歌的海

参与一下

Sub 统计()
Dim arr, brr, myrow, i, j, d As Object

Set d = CreateObject("Scripting.Dictionary")

With Sheets("sheet1")
    myrow = .Cells(Rows.Count, 1).End(3).Row
    arr = [a1].Resize(myrow, 2)
    ReDim brr(1 To myrow, 1 To 3)
    For i = 2 To myrow
        s = arr(i, 1) & "/" & arr(i, 2)
            If Not d.exists(s) Then
                m = m + 1
                d(s) = m
                brr(m, 1) = arr(i, 1)
                brr(m, 2) = arr(i, 2)
                brr(m, 3) = 1
            Else
                j = d(s)
                brr(j, 3) = brr(j, 3) + 1
            End If

    Next i
         [d2:f10000].ClearContents
         [d1].Resize(, 3) = [{"表箱类型","表箱型号","表箱数量"}]
         [d2].Resize(m, 3) = brr
         [d1].CurrentRegion.Borders.LineStyle = 1
End With
   Set d = Nothing

End Sub

LIUZHU

grf1973 发表于 2024-6-27 16:36
发现d[x]后直接x=x[0]+","+x[1]了。。。。。。

数组可以作为字典的键么？