[已解决]VBA用数组和字典 计算B列上班天数

laoau138

VBA用数组和字典   计算B列上班天数

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-6-17 08:54

1. Sub aaa()
   
2. Dim arr, brr, i&, r&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a1].CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To 2)
   
6. For i = 2 To UBound(arr)
   
7.   If Not d.exists(arr(i, 2)) Then
   
8.     r = r + 1
   
9.     d(arr(i, 2)) = r
   
10.     brr(r, 1) = arr(i, 2)
    
11.   End If
    
12.   brr(d(arr(i, 2)), 2) = brr(d(arr(i, 2)), 2) + 1
    
13. Next i
    
14. [e1].Resize(r, 2) = brr
    
15. End Sub
    
16. 
    
17. Sub bbb()
    
18. Dim arr, brr, ar, r&, d As Object
    
19. Set d = CreateObject("scripting.dictionary")
    
20. arr = Range("b2:b" & [b65536].End(3).Row)
    
21. ReDim brr(1 To UBound(arr), 1 To 2)
    
22. For Each ar In arr
    
23.   If Not d.exists(ar) Then
    
24.     r = r + 1
    
25.     d(ar) = r
    
26.     brr(r, 1) = ar
    
27.   End If
    
28.   brr(d(ar), 2) = brr(d(ar), 2) + 1
    
29. Next ar
    
30. [e1].Resize(r, 2) = brr
    
31. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, r&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a1].CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To 2)
   
6. For i = 2 To UBound(arr)
   
7.   If Not d.exists(arr(i, 2)) Then
   
8.     r = r + 1
   
9.     d(arr(i, 2)) = r
   
10.     brr(r, 1) = arr(i, 2)
    
11.   End If
    
12.   brr(d(arr(i, 2)), 2) = brr(d(arr(i, 2)), 2) + 1
    
13. Next i
    
14. [e1].Resize(r, 2) = brr
    
15. End Sub
    
16. 
    
17. Sub bbb()
    
18. Dim arr, brr, ar, r&, d As Object
    
19. Set d = CreateObject("scripting.dictionary")
    
20. arr = Range("b2:b" & [b65536].End(3).Row)
    
21. ReDim brr(1 To UBound(arr), 1 To 2)
    
22. For Each ar In arr
    
23.   If Not d.exists(ar) Then
    
24.     r = r + 1
    
25.     d(ar) = r
    
26.     brr(r, 1) = ar
    
27.   End If
    
28.   brr(d(ar), 2) = brr(d(ar), 2) + 1
    
29. Next ar
    
30. [e1].Resize(r, 2) = brr
    
31. End Sub

复制代码

laoau138

大灰狼1976 发表于 2017-6-17 08:54

果然是高手
这条如何做


用VBA两种方法   第一种数组    第二种字典


有1、2、3…999这999个数字中，用VBA数组和字典编写一段代码，在工作表的A列显示这些数被5除余1和余2的数字。


http://www.excelpx.com/thread-431236-1-1.html