帮忙解下汇总表将场所合并后按日期汇总每日总额

dagal

test.rar (1.01 MB, 下载次数: 38)

2018-7-29 00:32 上传

点击文件名下载附件

以下代码只是天的总汇总，但不知要变成门店合并单元格后，在第二列开始是日期按天来汇总：

1. Sub hz1()
   
2.     Dim nRow%, Arr(), Brr(), m%, n%
   
3.     Dim ds As Object
   
4.     Set ds = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("sheet1")
   
6.         nRow = .Range("d65536").End(xlUp).Row
   
7.         Arr = .Range("a1:g" & nRow).Value
   
8.     End With
   
9.     ReDim Brr(1 To nRow, 1 To 5)
   
10.     For i = 2 To nRow
    
11.         n = ds(Arr(i, 1))
    
12.         If n = 0 Then
    
13.             m = m + 1
    
14.             n = m
    
15.             ds(Arr(i, 1)) = m
    
16.             'Brr(m, 1) = m
    
17.             Brr(m, 2) = Arr(i, 1)
    
18.             Brr(m, 1) = Arr(i, 7)
    
19.         End If
    
20.         Brr(n, 3) = Brr(n, 3) + Arr(i, 4)
    
21.         Brr(n, 4) = Brr(n, 4) + Arr(i, 5)
    
22.         Brr(n, 5) = Brr(n, 5) + Arr(i, 6)
    
23.         
    
24.     Next
    
25.     Brr(m + 1, 1) = "合计"
    
26.     For i = 1 To m
    
27.         Brr(m + 1, 3) = Brr(m + 1, 3) + Brr(i, 3)
    
28.         Brr(m + 1, 4) = Brr(m + 1, 4) + Brr(i, 4)
    
29.         Brr(m + 1, 5) = Brr(m + 1, 5) + Brr(i, 5)
    
30.     Next
    
31.     With Me
    
32.         .Range("a3:e65536").ClearContents
    
33.         .Range("a3:e65536").Borders.LineStyle = 0
    
34.         .Range("a3:e" & m + 3).Value = Brr
    
35.         .Range("a3:e" & m + 3).Borders.LineStyle = 1
    
36.     End With
    
37. End Sub
    

复制代码

dagal

就是将sheet1的数据转换成汇总表的形式，请各位大神指教，谢谢！

dagal

好人一生平安！

BenjaminToo

1. Sub hz1()
   
2.     Dim nRow%, Arr(), Brr(), m%, n%, js$
   
3.     Dim ds As Object
   
4.     Application.DisplayAlerts = False
   
5.     Set ds = CreateObject("Scripting.Dictionary")
   
6.     With Sheets("sheet1")
   
7.         nRow = .Range("d65536").End(xlUp).Row
   
8.         Arr = .Range("a1:g" & nRow).Value
   
9.     End With
   
10.     ReDim Brr(1 To nRow, 1 To 5)
    
11.    
    
12.     For i = 2 To nRow
    
13.         js = CStr(Arr(i, 7) & Arr(i, 1))
    
14.         If Not ds.exists(js) Then
    
15.             n = n + 1
    
16.             ds(js) = n
    
17.             Brr(n, 1) = Arr(i, 7)
    
18.             Brr(n, 2) = Arr(i, 1)
    
19.             Brr(n, 3) = Arr(i, 4)
    
20.             Brr(n, 4) = Arr(i, 5)
    
21.             Brr(n, 5) = Arr(i, 6)
    
22.         Else
    
23.       
    
24.             Brr(ds(js), 3) = Brr(ds(js), 3) + Arr(i, 4)
    
25.             Brr(ds(js), 4) = Brr(ds(js), 4) + Arr(i, 5)
    
26.             Brr(ds(js), 5) = Brr(ds(js), 5) + Arr(i, 6)
    
27.    
    
28.         End If
    
29.     Next
    
30.    
    
31. Brr(n + 1, 1) = "合计"
    
32. [a3].Resize(n + 3, 5).Value = Brr
    
33. Range("A3:E" & n + 1).Sort Key1:=Range("A3:A" & n + 1), Order1:=xlAscending
    
34. For m = n + 2 To 2 Step -1
    
35.     If Cells(m, 1).Value = Cells(m - 1, 1).Value Then
    
36.         Union(Cells(m, 1), Cells(m - 1, 1)).Merge
    
37.     End If
    
38. Next
    
39.    
    
40. With Sheets("汇总")
    
41.     .Range("a3:e65536").Borders.LineStyle = 0
    
42.     .Range("a3:e" & n + 3).Borders.LineStyle = 1
    
43.     .Cells(n + 3, 3) = Application.WorksheetFunction.Sum(Range("C3:C" & n + 2))
    
44.     .Cells(n + 3, 4) = Application.WorksheetFunction.Sum(Range("D3:D" & n + 2))
    
45.     .Cells(n + 3, 5) = Application.WorksheetFunction.Sum(Range("E3:E" & n + 2))
    
46. End With
    
47. Application.DisplayAlerts = True
    
48. End Sub
    
49. 
    

复制代码

按照你的代码改了一下，你看看这样可以不

BenjaminToo

以上，不知道有没错，你试下

不知道为什么

如图

不知道为什么

dagal 发表于 2018-7-28 23:53
就是将sheet1的数据转换成汇总表的形式，请各位大神指教，谢谢！

不知道对你的需求理解的是否正确：同样场所相同月份的数据累计汇总。

dagal

BenjaminToo 发表于 2018-7-29 16:41
以上，不知道有没错，你试下

没错没错，可以，谢谢~送你小花了！

dagal

不知道为什么 发表于 2018-7-29 21:19
不知道对你的需求理解的是否正确：同样场所相同月份的数据累计汇总。

谢谢~给你送小花了！