用函数出现一些问题，VBA能否解决。谢谢~！

挟香公子

wodewan 发表于 2020-1-17 10:19
Sub test()
Dim arr, br, i, d As Object, str, lr, m
Set d = CreateObject("scripting.dictionary")

厉害，这个代码基本上看不懂。但效率非常高！

挟香公子

microyip 发表于 2020-1-17 11:26
附上附件以供参考

ClassSQL那么长的代码都带上注释，感谢！

yes363001640

挟香公子 发表于 2020-1-17 13:35
感谢！代码有些问题，
If Month(arr(i, 1)) = Month(brr(j, 1)) Then
应该匹配的是年月，这里只匹配了 ...

是的，我看你给的数据都是同一年的。所以··

microyip

挟香公子 发表于 2020-1-17 14:03
ClassSQL那么长的代码都带上注释，感谢！

那个注释是因为另有一个示例帖子里的类的，凡是使用SQL就直接搬来用就可以了

挟香公子

yes363001640 发表于 2020-1-17 14:58
是的，我看你给的数据都是同一年的。所以··

嗯嗯，已经可用了！

挟香公子

microyip 发表于 2020-1-17 16:03
那个注释是因为另有一个示例帖子里的类的，凡是使用SQL就直接搬来用就可以了

哈哈！青铜只觉得很神奇！感谢！

挟香公子

wodewan 发表于 2020-1-17 10:19
Sub test()
Dim arr, br, i, d As Object, str, lr, m
Set d = CreateObject("scripting.dictionary")

在您的代码基础上自己根据需要的变化修改了一下，目前可以使用。但不知道能不能更精简一下。也为了能够更好的学习VBA代码。
有几处修改过程出现错误或者需要的功能，在下面代码有标注。

1. Option Explicit
   
2. 
   
3. Sub test()
   
4. Dim arr, br, i, d As Object, str, lr, m, hb, ytr, strY, ytrY
   
5. Set d = CreateObject("scripting.dictionary")
   
6. hb = Sheets(7).Cells(Rows.Count, 1).End(xlUp).Row
   
7. arr = Sheets(6).Range("a1").CurrentRegion
   
8. ReDim br(1 To UBound(arr), 1 To 4)
   
9. 
   
10. If hb < 2 Then     '不定义hb>=2,在新表使用m返回空值报错
    
11.     hb = 2
    
12. End If
    
13. 
    
14. For i = 2 To UBound(arr)
    
15.     str = Format(arr(i, 1), "yyyy-mm")
    
16.     ytr = Format(Sheets(7).Cells(hb, 1), "yyyy-mm")
    
17.     strY = Format(str, "General Number")
    
18.     ytrY = Format(ytr, "General Number")
    
19.     If strY > ytrY Or strY = ytrY Then
    
20.         str = Format(arr(i, 1), "yyyy-mm")
    
21.         lr = arr(i, 2) - arr(i, 3)
    
22.         If Not d.exists(str) Then
    
23.             m = m + 1
    
24.             br(m, 1) = str: br(m, 3) = lr: br(m, 4) = 1
    
25.             d(str) = m
    
26.         Else
    
27.             br(d(str), 3) = br(d(str), 3) + lr
    
28.             br(d(str), 4) = br(d(str), 4) + 1
    
29.             br(d(str), 2) = br(d(str), 3) / br(d(str), 4)
    
30.         End If
    
31.     End If
    
32. Next
    
33. 
    
34. With Sheets(7)
    
35.     .UsedRange.Offset(hb, 0).ClearContents
    
36.     .Cells(hb, 1).Resize(m, 2) = br             '不计算月份净利润，直接返回月份中的平均日利润到B列。
    
37. End With
    
38. 
    
39. 
    
40. For i = 1 To m
    
41.     With Sheets(7)                              '把返回的日期数据重新换成标准日期，单元格格式设置为yyyy/m，方便后面其他表格匹配年月份获取数据。
    
42.                 .Cells(hb, 1) = Format(br(i, 1), "ddddd")
    
43.         hb = hb + 1
    
44.     End With
    
45. Next
    
46. 
    
47. End Sub
    
48. 
    
49. 'sheets(7)为数据汇总表格。sheets(6)为账目表格。
    
50. '定义汇总表的hb行号是为了避免每一次汇总数据全部重算一次，这样计算过程较长会造成电脑假死。
    

复制代码