房开企业根据销售日报制作销售统计表。

舟飞浪扬

求助VBA大神帮忙编写代码，在线等，不胜感激.具体要求是：
1.第一张表销控表需要汇总后续每张表的销售数据。按房号和姓名进行统计，累计收到的购房款、工本费、维修基金、办证费和车位款。
2.第二张表开始是2月12日至2月16日的销售日报。

yynrzwh

2-12至2-16日报.zip (19.99 KB, 下载次数: 14)

2024-3-9 16:53 上传

点击文件名下载附件

半百

请测试。。。

舟飞浪扬

谢谢各位大神

lushang2018

1. Sub 测试()
   
2.     Dim i%, j%, k%, m%, n%, arr, brr, crr, drr
   
3.     Dim rng As Range, sht As Worksheet, wbk As Workbook
   
4.     Dim dic As Object, key, keys, items
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.     ReDim brr(1 To 7)
   
7.     For i = 1 To Sheets.Count
   
8.         Set sht = Sheets(i)
   
9.         If sht.Name <> "销控表" Then
   
10.             arr = sht.Range("A1").CurrentRegion.Value
    
11.             For j = 4 To UBound(arr)
    
12.                 key = arr(j, 12)
    
13.                 If Not dic.Exists(key) Then
    
14.                     brr(1) = key
    
15.                     brr(2) = arr(j, 3)
    
16.                     brr(列号(arr(j, 10))) = arr(j, 9)
    
17.                     dic(key) = brr
    
18.                 Else
    
19.                     brr = dic(key)
    
20.                     brr(列号(arr(j, 10))) = brr(列号(arr(j, 10))) + arr(j, 9)
    
21.                     dic(key) = brr
    
22.                 End If
    
23.             Next
    
24.         End If
    
25.     Next
    
26.     keys = dic.keys
    
27.     ReDim crr(1 To 1000, 1 To 7)
    
28.     For i = LBound(keys) To UBound(keys)
    
29.         key = keys(i)
    
30.         brr = dic(key)
    
31.         k = k + 1
    
32.         For j = 1 To 7
    
33.            crr(k, j) = brr(j)
    
34.         Next
    
35.     Next
    
36.     Sheet1.Range("A2").Resize(UBound(crr), 7) = crr
    
37. End Sub
    
38. Function 列号(s)
    
39.     Select Case s
    
40.         Case Is = "购房款"
    
41.             列号 = 3
    
42.         Case Is = "工本费"
    
43.             列号 = 4
    
44.         Case Is = "维修基金"
    
45.             列号 = 5
    
46.         Case Is = "办证费"
    
47.             列号 = 6
    
48.         Case Is = "车位款"
    
49.             列号 = 7
    
50.     End Select
    
51. End Function
    

复制代码

lushang2018

试一试，试一试

舟飞浪扬

lushang2018 发表于 2024-3-9 21:01
试一试，试一试

楼主你的运行结果不正确。

舟飞浪扬

yynrzwh 发表于 2024-3-9 16:53

这是字典套字典的方法，妙

舟飞浪扬

半百 发表于 2024-3-9 17:25
请测试。。。

这是字典套数组用法，妙

舟飞浪扬

lushang2018 发表于 2024-3-9 21:01
试一试，试一试

不错 ，谢谢楼主的支持