[µo°Ý] ºâ¬Û¦P¦¸¼Æ

starbox520

¥H Loadboard  ¬°¥D ¡A T-unit & Sitemap ¦pªG¬Û¦P¡A²Î­p¦³´X²Õ¬Û¦P
   

¤U¸ü (20.44 KB)

2016-12-6 18:14

   
    Test001.rar (22.69 KB)

¤U¸ü¦¸¼Æ: 5

2016-12-6 18:16

starbox520

¦^´_ 3# hcm19522


    ­ì¨Ó¡A¤£¥Î¥Î¨ìVBA¤]¯à¸Ñ¥X!!!

hcm19522

http://blog.xuite.net/hcm19522/twblog/473951498

starbox520

¦^´_ 1# starbox520

¤w¼g¥X¨ÓºO~¦U¦ì°ª¤â«üÂI«üÂI><"

1. Sub ttt()
   
2. Dim dic As Object, brr, i%, arr(1 To 5000, 1 To 4)
   
3. brr = Sheet3.Range("a1").CurrentRegion
   
4. Set dic = CreateObject("Scripting.Dictionary")
   
5. For i = 2 To UBound(brr)
   
6.     s = brr(i, 4) & brr(i, 8) & brr(i, 9)
   
7.     If Not dic.Exists(s) Then
   
8.         n = n + 1
   
9.         dic(s) = n
   
10.         arr(n, 1) = brr(i, 8)
    
11.         arr(n, 2) = brr(i, 4)
    
12.         arr(n, 3) = brr(i, 9)
    
13.         arr(n, 4) = 1
    
14.     Else
    
15.         arr(dic(s), 4) = arr(dic(s), 4) + 1
    
16.     End If
    
17. Next
    
18. If n > 1 Then
    
19.     With Sheet4.Range("a1")
    
20.         .CurrentRegion.Offset(1).ClearContents
    
21.         .Offset(1).Resize(n, 4) = arr
    
22.     End With
    
23. End If
    
24. Set dic = Nothing
    
25. End Sub

½Æ»s¥N½X