数据相加代码问题

michaelaa

论坛的老师周末好,抽空帮忙看一下附件的代码,实现不了我想要的功能,帮忙看一下哪里需要修改,谢谢!

shiruiqiang

为啥表1的字典值为 0 ？

titi012

参与一下啊......

1. Private Sub CommandButton1_Click()
   
2.    
   
3.     Dim i, j, arr, brr
   
4.     Dim dic, d As Object
   
5.     Dim key, k
   
6.     Set dic = CreateObject("scripting.dictionary")
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.    
   
9.     arr = Sheet1.Range("A1").CurrentRegion
   
10.     For i = 2 To UBound(arr)
    
11.         k = arr(i, 1)
    
12.         If Not dic.exists(k) Then Set dic(k) = CreateObject("Scripting.Dictionary")
    
13.         For j = 2 To UBound(arr, 2)
    
14.             key = arr(1, j)
    
15.             If Not dic(k).exists(key) Then
    
16.                 dic(k)(key) = arr(k, j)
    
17.             Else
    
18.                 dic(k)(key) = arr(k, j) + dic(k)(key)
    
19.             End If
    
20.             d(key) = ""
    
21.         Next
    
22.     Next
    
23.    
    
24.     arr = Sheet2.Range("A1").CurrentRegion
    
25.     For i = 2 To UBound(arr)
    
26.         k = arr(i, 1)
    
27.         If Not dic.exists(k) Then Set dic(k) = CreateObject("Scripting.Dictionary")
    
28.         For j = 2 To UBound(arr, 2)
    
29.             key = arr(1, j)
    
30.             If Not dic(k).exists(key) Then
    
31.                 dic(k)(key) = arr(k, j)
    
32.             Else
    
33.                 dic(k)(key) = arr(k, j) + dic(k)(key)
    
34.             End If
    
35.             d(key) = ""
    
36.         Next
    
37.     Next
    
38.    
    
39.     ReDim arr(0 To dic.Count, 0 To d.Count)
    
40.     i = 0: j = 0
    
41.     For Each k In dic.keys
    
42.         i = i + 1
    
43.         arr(i, 0) = k
    
44.         For Each key In d.keys
    
45.             If i = 1 Then j = j + 1: arr(0, j) = key
    
46.             If dic(k).exists(key) Then arr(i, j) = dic(k)(key)
    
47.         Next
    
48.     Next
    
49.    
    
50.     Sheet1.Range("A1").Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
    
51. 
    
52. End Sub

复制代码

cjc209

自定义 jsa 代码完成效果

michaelaa

shiruiqiang 发表于 2025-3-15 10:31
为啥表1的字典值为 0 ？

感谢老师回复,结果还是不正确

michaelaa

cjc209 发表于 2025-3-15 11:19
自定义 jsa 代码完成效果

谢谢老师回复,无法使用WPS.

taller

michaelaa

taller 发表于 2025-3-15 11:36

感谢老师回复,结果正确