用VBA实现多工作表条件求和

leonyjh

目前是通过mc=MID(GET.WORKBOOK(1),FIND("]",GET.WORKBOOK(1))+1,99)&T(NOW())
和SUMPRODUCT((SUMIF(INDIRECT("'"&mc&"'!a7:a50"),AA7,INDIRECT("'"&mc&"'!f7:f50"))))来实现的，求用VBA实现，工作表名字不规则


补充内容 (2018-8-8 20:39):
我想用vba实现不规则名称的多个工作表条件求和

不知道为什么

天马行空 没附件，让大家陪你一起想象？

leonyjh

这是附件。。。。。

leonyjh

不知道为什么 发表于 2018-8-6 11:38
天马行空 没附件，让大家陪你一起想象？

附件在3楼。。。。。

不知道为什么

leonyjh 发表于 2018-8-6 11:47
附件在3楼。。。。。

可以把你的需求描述详细啊，照顾下不懂函数的

leonyjh

有没有人帮帮忙

xiangbaoan

leonyjh 发表于 2018-8-8 20:42
有没有人帮帮忙

……对了，请不吝啬花哟………………

1. Sub test()
   
2. Dim d As Object, ar, br, r&, c%, sh As Worksheet, y%
   
3. With Me
   
4.     ar = Intersect(.[aa1].CurrentRegion, .[aa:af])
   
5. End With
   
6. Set d = CreateObject("scripting.dictionary")
   
7. For r = 7 To UBound(ar)
   
8.     If InStr(ar(r, 1), "-") Then
   
9.         d(ar(r, 1)) = r
   
10.         ar(r, 5) = 0
    
11.     End If
    
12. Next
    
13. For Each sh In Sheets
    
14.     With sh
    
15.         If .Name <> Me.Name Then
    
16.             br = .[a1].CurrentRegion.Resize(, 7)
    
17.             For r = 7 To UBound(br)
    
18.                 If d.exists(br(r, 1)) Then
    
19.                     y = d(br(r, 1))
    
20.                     ar(y, 5) = ar(y, 5) + br(r, 6)
    
21.                 End If
    
22.             Next
    
23.         End If
    
24.     End With
    
25. Next
    
26. With Me
    
27.     Intersect(.[aa1].CurrentRegion, .[aa:af]) = ar
    
28. End With
    
29. Set d = Nothing
    
30. MsgBox "ok!"
    
31. End Sub

复制代码

leonyjh

xiangbaoan 发表于 2018-8-8 21:27
……对了，请不吝啬花哟………………

请问，能不能弄成函数呢，不要弄成按钮的