函数解决不了，求助VBA大神

335356119

不知道为什么 发表于 2018-9-15 17:46

能把代码发下吗？谢谢

不知道为什么

335356119 发表于 2018-9-15 17:49
能把代码发下吗？谢谢

供参考

1. Sub test1()
   
2.     Dim Dic, Arr, Brr()
   
3.     Set Dic = CreateObject("scripting.dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Arr = Sheets("数据表").[a1].CurrentRegion
   
6.     ReDim Brr(1 To UBound(Arr), 1 To 10)
   
7.     For i = 2 To UBound(Arr)
   
8.         rq = DateValue(Arr(i, 1))
   
9.         If Not Dic.exists(rq) Then
   
10.             Set Dic(rq) = CreateObject("scripting.dictionary")
    
11.         End If
    
12.         
    
13.         If Not Dic(rq).exists(Arr(i, 3)) Then
    
14.             Set Dic(rq)(Arr(i, 3)) = CreateObject("scripting.dictionary")
    
15.         End If
    
16.         Dic(rq)(Arr(i, 3))(Arr(i, 2)) = Dic(rq)(Arr(i, 3))(Arr(i, 2)) + Arr(i, 5)
    
17.     Next i
    
18.     With Sheets("VBA查询")
    
19.         rq = DateValue(.Cells(1, 1))
    
20.         If Dic.exists(rq) Then
    
21.             For Each k In Dic(rq).keys
    
22.                 x = x + 1
    
23.                 Brr(x, 6) = k
    
24.            For i = 2 To UBound(Arr)
    
25.              If DateValue(Arr(i, 1)) = rq And Arr(i, 3) = k Then
    
26.                 s = s + 1
    
27.              End If
    
28.            Next i
    
29.            Brr(x, 4) = s: s = 0
    
30.                 For Each k1 In Dic(rq)(k).keys
    
31.                     Brr(x, 1) = Join(Dic(rq)(k).keys, "/")
    
32.                     Brr(x, 3) = Join(Dic(rq)(k).items, "/")
    
33.                 Next
    
34.             Next
    
35.         End If
    
36.         For i = 1 To x
    
37.             If InStr(Brr(i, 3), "/") Then
    
38.                 For n = 0 To UBound(Split(Brr(i, 3), "/"))
    
39.                     pj = Val(Split(Brr(i, 3), "/")(n)) \ Brr(i, 4)
    
40.                     mm = mm & "/" & pj
    
41.                 Next n
    
42.                 Brr(i, 5) = Right(mm, Len(mm) - 1): mm = ""
    
43.             Else
    
44.                 Brr(i, 5) = Brr(i, 3) \ Brr(i, 4)
    
45.             End If
    
46.         Next i
    
47.          .[a3:f999].ClearContents
    
48.         .[a3].Resize(x, 6) = Brr
    
49.         .Activate
    
50.     End With
    
51.     Set Dic = Nothing
    
52.     Application.ScreenUpdating = True
    
53. End Sub
    

复制代码

335356119

不知道为什么 发表于 2018-9-15 17:51
供参考

你好，请教一下，我想手动输入人数，请问应该修改哪里？我把brr(i,4)全部改成cells(i,4)，没成功。数据里的并不是一个产品就是一个人数。谢谢大神！

335356119

不知道为什么 发表于 2018-9-15 17:51
供参考

请问：Brr(x, 4) = s: s = 0 这个怎么理解

iwangyi

335356119 发表于 2018-9-15 17:23
这个好像有报错

调试加了断点sToP，去了就可以