多条件求和

leon小鱼

ivccav 发表于 2017-12-21 18:22
13楼提供的代码是固定了行数和列数的，没有考虑到扩展性（增加店数，增加日期等等）。我的代码是计算F列之 ...

好像可以了，是日期格式不匹配就会报错

ivccav

leon小鱼 发表于 2017-12-22 09:26
好像可以了，是日期格式不匹配就会报错

我是假定你的日期是正确的。如果数据不规范，要做很多判断才可以不报错。判断是不是日期，可以用IsDate判断。还有，如果你的单元格是错误值（#N/A, #VALUE!, #REF!, #DIV/0!, #NUM!, #NAME?, or #NULL!），程序也会报错，需要IsError判断。可能性太多了，我不可能都给你全部判断一遍的。数据规范很重要。

leon小鱼

ivccav 发表于 2017-12-22 09:53
我是假定你的日期是正确的。如果数据不规范，要做很多判断才可以不报错。判断是不是日期，可以用IsDate判 ...

谢谢，已经差不多可以用了

ivccav

leon小鱼 发表于 2017-12-22 10:14
谢谢，已经差不多可以用了

不是日期格式不匹配程序会报错，而是你的数据不是日期才会报错。防止报错可以先判断是不是日期，用Isdate判断，如果不是日期，还要看能不能转换成日期，这个非常复杂，谁也不可能提前知道你的数据是什么，如果是“2017-12-1”这样的字符串，可以用Cdate函数转换成日期，如果是文字，就没可能转成日期。就算是日期，也要看格式，YYYY-M-D格式和YYYY-MM-DD也无法比较，所有需要用Format函数统一格式，才好比较（我是用Clng转换成长整型，一样的效果）。

EXCEL的数据格式太自由了，写程序不是你想的那么简单，要考虑很多繁琐的细节。数据放在数据库中是最理想的，因为错误的格式根本没法输入。

zorsite

这种需求真的应该用数据透视表，不需要编程，只需要鼠标点点就能够完成你的数据汇总工作，强烈建议楼主研究研究。
用VBA可以满足你的需求，但是你的需求会变化，会不断有新需求、新想法。要么学好VBA撸袖子自己干，要么用数据透视表。
以下代码在ivccav的基础上修改而来，感谢ivccav提供了最核心的思路和功能。
代码没有考虑累计销售、报表日销售和最后一行的小计。

1. Option Explicit
   
2. Sub 数组整体写入()
   
3.     Dim d As Object
   
4.     Dim arr, brr
   
5.     Dim i As Integer, r As Integer, c As Integer
   
6.     Dim rs As Integer, cs As Integer
   
7.     Dim k As String
   
8.     Dim rng As Range
   
9.     Application.ScreenUpdating = False
   
10.     Set d = CreateObject("Scripting.Dictionary")
    
11.     arr = Sheet2.Range("a1").CurrentRegion '将源数据写入数组
    
12.     For i = 2 To UBound(arr) '统计源数据至字典
    
13.         k = arr(i, 1) & CLng(arr(i, 3))
    
14.         d(k) = d(k) + arr(i, 7)
    
15.     Next
    
16.     rs = Sheet1.Range("D" & Sheet1.Cells.Rows.Count).End(xlUp).Row
    
17.     cs = Sheet1.Range("F1").End(xlToRight).Column
    
18.     Set rng = Sheet1.Range(Sheet1.Cells(2, 7), Sheet1.Cells(rs, cs))
    
19.     rng.Clear '清除目标区域
    
20.     ReDim brr(2 To rs, 7 To cs)
    
21.     For r = 2 To rs
    
22.         For c = 7 To cs
    
23.             k = Cells(r, 3) & CLng(Cells(1, c))
    
24.             brr(r, c) = d(k) '先把统计数据写入数组
    
25.         Next
    
26.     Next
    
27.     rng = brr   '再写入目标区域。优点是快，缺点是没法跳过小计行，没法为小计行添加公式。
    
28.     Set d = Nothing
    
29.     Application.ScreenUpdating = True
    
30. End Sub
    
31. 
    
32. Sub 单元格逐个写入()
    
33.     Dim d As Object
    
34.     Dim arr
    
35.     Dim i As Integer, r As Integer, c As Integer
    
36.     Dim rs As Integer, cs As Integer
    
37.     Dim k As String
    
38. 
    
39.     Application.ScreenUpdating = False
    
40.     Set d = CreateObject("Scripting.Dictionary")
    
41.     arr = Sheet2.Range("a1").CurrentRegion '将源数据写入数组
    
42.     For i = 2 To UBound(arr) '统计源数据至字典
    
43.         k = arr(i, 1) & CLng(arr(i, 3))
    
44.         d(k) = d(k) + arr(i, 7)
    
45.     Next
    
46.     rs = Sheet1.Range("D" & Sheet1.Cells.Rows.Count).End(xlUp).Row '倒数第二行
    
47.     cs = Sheet1.Range("F1").End(xlToRight).Column '最后一列
    
48.     Sheet1.Range(Sheet1.Cells(2, 7), Sheet1.Cells(rs, cs)).Clear '清除目标数据
    
49. 
    
50.     For r = 2 To rs
    
51.         For c = 7 To cs
    
52.             If IsEmpty(Sheet1.Cells(r, 3).Value) Then '如果某行的门店号为空，表明该行为小计，需插入求和公式
    
53.                 Sheet1.Cells(r, c).FormulaR1C1 = "=SUM(R[-" & r - 2 & "]C:R[-1]C)" '如果有多行小计则需要更换判断标准
    
54.             Else
    
55.                 k = Cells(r, 3) & CLng(Cells(1, c))
    
56.                 Sheet1.Cells(r, c) = d(k) '填入门店统计数据
    
57.             End If
    
58.         Next
    
59.     Next
    
60.     Set d = Nothing
    
61.     Application.ScreenUpdating = True
    
62. End Sub
    

复制代码

leon小鱼

zorsite 发表于 2017-12-22 13:41
这种需求真的应该用数据透视表，不需要编程，只需要鼠标点点就能够完成你的数据汇总工作，强烈建议楼主研究 ...

你好，基础的函数和透析表都会，这是每日重复的工作，需要365天重复制作，所以需要简单的VBA减少重复劳动时间。谢谢您的答疑~

leon小鱼

ivccav 发表于 2017-12-21 18:22
13楼提供的代码是固定了行数和列数的，没有考虑到扩展性（增加店数，增加日期等等）。我的代码是计算F列之 ...

大神，你好，最近不知道什么原因，代码开始一行一行出现，速度奇慢。以前是秒出的，我现在重新下了测试文件，好慢！！！！烦请大神看下原因