求助：左边是数据源，用VBA把左边的数据汇总到右边的式样

2217918

求助：左边是数据源，用VBA把左边的数据汇总到右边的式样。谢谢！！！

liulang0808

字典案例，楼主餐卡下
https://club.excelhome.net/threa ... tml?_dsign=b73ad3d6

sdytsxd991122

sdytsxd991122

用数据透视表比较方便

2217918

sdytsxd991122 发表于 2024-1-25 14:16

收到，我要做成加载宏，还是用VBA 谢谢老师！

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.25
   
2.     Dim arr, brr, d
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("Sheet1")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .Range("a1:g" & r)
   
7.         For i = 2 To UBound(arr)
   
8.             s = arr(i, 2)
   
9.             If Not d.exists(s) Then
   
10.                 d(s) = Array(1, arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7))
    
11.             Else
    
12.                 t = d(s)
    
13.                 t(0) = t(0) + 1
    
14.                 For x = 1 To 4
    
15.                     t(x) = t(x) + arr(i, x + 3)
    
16.                 Next
    
17.                 d(s) = t
    
18.             End If
    
19.         Next
    
20.         ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
21.         For Each k In d.keys
    
22.             m = m + 1
    
23.             brr(m, 1) = k
    
24.             brr(m, 2) = d(k)(0)
    
25.             brr(m, 3) = d(k)(4) / d(k)(0)
    
26.             For x = 1 To 4
    
27.                 brr(m, x + 3) = d(k)(x)
    
28.             Next
    
29.         Next
    
30.         .[j3:p1000] = ""
    
31.         .[j3].Resize(m, 7) = brr
    
32.     End With
    
33.     MsgBox "OK！"
    
34. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

cjc209

function test(){
        var arr=maxArray_Z("a2:g2");
        var arr1=groupInto_Z(arr,"f2#",g=>[g.count_Z(),g.sum_Z("f7")/g.count_Z(),g.sum_Z("f4"),g.sum_Z("f5"),g.sum_Z("f6"),g.sum_Z("f7")],0)
        arr1.toRange_Z("j3")
}

2217918

sdytsxd991122 发表于 2024-1-25 14:16

    以上代码在表格中可以运行，但是我转换成加载宏，在加载宏中运行提示出错，Sheet1.Range("J3").CopyFromRecordset Cn.Execute(strSQL)，麻烦老师您帮我修改下，谢谢！

Sc2022

学习才是最重要