gaishutsusuru

¦^´_ 3# ikboy


ikboy¤j¤j¡A

ÁÂÁ±zªº¨ó§U¡C

¦b¾Þ§@¥¨¶°ªº¹Lµ{¤¤¡A¦³¤@¨Ç¤p°ÝÃD¡A·Q½Ð±Ð±z¡G
1. ·|¥X²{¦pÀɮשҥܪºN/A
2. ±N²Ä¤­¦æªº¸ê®Æ½Æ»s¨ì²Ä¤»¦æ¡B²Ä¤C¦æ¡A·|¥X²{°õ¦æ¶¥¬q¿ù»~'9' °}¦C¯Á¤Þ¶W¥X½d³ò¡C
°»¿ù·|¦b¡Gb(3 + jjj, j + jj) = tt(jjj)

·Q½Ð°Ý¦p¦ó¸Ñ¨M©O¡AÁÂÁ±zªº¨ó§U¡C

¬¡­¶Ã¯1 (2).zip (16.06 KB)

¤U¸ü¦¸¼Æ: 3

2019-6-18 18:47

ikboy

1. Sub zz()
   
2. Dim d As Object, a, k, t, b(), n&, m&, kk, tt
   
3. Set d = CreateObject("scripting.dictionary")
   
4. a = Range("a2:e" & [e1048576].End(3).Row)
   
5. For i = 1 To UBound(a)
   
6.     d("@" & a(i, 2)) = ""
   
7.     k = a(i, 2) & "|" & a(i, 3)
   
8.     If Not d.exists(k) Then
   
9.         d(k) = Array(a(i, 4), a(i, 5), a(i, 5))
   
10.     Else
    
11.         t = d(k)
    
12.         t(0) = t(0) & "|" & a(i, 4)
    
13.         t(1) = t(1) & "|" & a(i, 5)
    
14.         t(2) = t(2) + a(i, 5)
    
15.         d(k) = t
    
16.     End If
    
17. Next
    
18. k = Filter(d.keys, "@")
    
19. ReDim b(1 To UBound(a), 1 To UBound(k) + 1)
    
20. For j = 0 To UBound(k)
    
21.     b(1, j + 1) = Mid(k(j), 2)
    
22.     d.Remove (k(j))
    
23.     kk = Filter(d.keys, b(1, j + 1) & "|")
    
24.     For ii = 0 To UBound(kk)
    
25.         t = d(kk(ii))
    
26.         b(ii + 2, j + 1) = Split(kk(ii), "|")(1) & ":" & t(2)
    
27.         m = m + 1
    
28.         n = IIf(ii + 2 > n, ii + 2, n)
    
29.     Next
    
30. Next
    
31. [h7].Resize(n, UBound(b, 2)) = b
    
32. k = d.keys
    
33. ReDim b(1 To UBound(a), 1 To m * 2): j = 0
    
34. For i = 0 To UBound(k)
    
35.     kk = Split(k(i), "|")
    
36.     t = d(k(i))
    
37.     j = j + 1
    
38.     b(1, j) = kk(0)
    
39.     b(2, j) = kk(1) & ":" & t(2)
    
40.     For jj = 0 To 1
    
41.         tt = Split(t(jj), "|")
    
42.         For jjj = 0 To UBound(tt)
    
43.             b(3 + jjj, j + jj) = tt(jjj)
    
44.         Next
    
45.     Next
    
46.     n = IIf(jjj + 2 > n, jjj + 3, n)
    
47.     j = j + 1
    
48. Next
    
49. [m7].Resize(n, UBound(b, 2)) = b
    
50. Set d = Nothing
    
51. End Sub

½Æ»s¥N½X

hcm19522

https://blog.xuite.net/hcm19522/twblog/587174675