¦p¦ó³z¹L¼gµ{¦¡¤§¤è¦¡±NabÄæ¦ì¾ã¦X

hsu.zoe

½Ð°Ý¦p¦ó±N(¤@)¤§¸ê®Æ³z¹L¼gµ{¦¡¤§¤è¦¡Âà´«¦¨(¤G)¡AA~D¥Nªí¤½¥q¦WºÙ¬O¤@¼Ëªº¡B1~10¥Nªí¨C¤@­Ó¤£¦Pªº³¡ªù¦WºÙ¡C

            (¤@)                                                          (¤G)
¤½¥q¦WºÙ        ³¡ªù¦WºÙ                                        ¤½¥q¦WºÙ        ³¡ªù¦WºÙ        ³¡ªù¦WºÙ        ³¡ªù¦WºÙ        ³¡ªù¦WºÙ
  A        1                                                         A               1               2               3
  A        2                                                         B               4               5
  A        3                                                         C               6
B        4                           ¡÷                           D                7                8               9              10
B        5
C        6
D        7
D        8
D        9
D        10

dechiuan999

§A¦n¡G

  ½Ð¸Õ¸Õ¦p¤U¡G

1. Sub bb()
   
2.    
   
3.     Dim mSht As Worksheet
   
4.     Dim mRng As Range, E As Range
   
5.     Dim ar, mSplit
   
6.     Dim mDic As Object
   
7.     Dim s%, s1%, s2%
   
8.    
   
9.    
   
10.     Set mDic = CreateObject("scripting.dictionary")
    
11.     Set mSht = Worksheets(1)
    
12.     With mSht
    
13.         Set mRng = .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
    
14.         
    
15.         For Each E In mRng
    
16.            
    
17.             If Not mDic.Exists(E.Value) Then
    
18.                 mDic(E.Value) = E.Offset(, 1).Value
    
19.             Else
    
20.                
    
21.                 mDic(E.Value) = mDic(E.Value) & "," & E.Offset(, 1)
    
22.                
    
23.             End If
    
24.          
    
25.         Next
    
26.       
    
27.         s = 1
    
28.         s1 = 10
    
29.         For Each ar In mDic.Keys
    
30.             .Cells(s, s1) = ar
    
31.             mSplit = Split(mDic(ar), ",")
    
32.             For s2 = 0 To UBound(mSplit)
    
33.                 .Cells(s, s1 + 1) = mSplit(s2)
    
34.                 .Cells(1, s1 + 1) = "³¡ªù¦WºÙ"
    
35.                 s1 = s1 + 1
    
36.             Next
    
37.             s = s + 1
    
38.             s1 = 10
    
39.         Next
    
40.         
    
41.     End With
    
42.    
    
43. End Sub

½Æ»s¥N½X

oobird

1. Sub test()
   
2.     Dim d As Object, a, b(100), m%, i%
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     a = Range([a1], [b65536].End(3))
   
5.     ReDim arr(1 To UBound(a), 1 To UBound(a))
   
6.     For i = 1 To UBound(a)
   
7.         If Not d.exists(a(i, 1)) Then
   
8.             m = m + 1
   
9.             d(a(i, 1)) = m
   
10.             arr(m, 1) = a(i, 1): arr(m, 2) = a(i, 2): b(m) = 2
    
11.         Else
    
12.             b(m) = b(m) + 1
    
13.             arr(d(a(i, 1)), b(m)) = a(i, 2)
    
14.             x = IIf(b(m) > x, b(m), x)
    
15.         End If
    
16.     Next
    
17.     If x > 2 Then
    
18.         For i = 3 To x
    
19.             arr(1, i) = arr(1, 2)
    
20.         Next
    
21.     End If
    
22.     [d1].Resize(m, x) = arr
    
23. End Sub

½Æ»s¥N½X

hsu.zoe

¦hÁ¤j¤jªº¸Ô¸Ñ~§Ú¤w¸g¸Õ¦¨¥\ÂP ^.^

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (42.27 KB)

2023-5-23 15:20

°õ¦æµ²ªG:

¤U¸ü (51.22 KB)

2023-5-23 15:21

Option Explicit
Sub TEST()
Dim Brr, Crr, Y, i&, T$, M%
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([B1], [A65536].End(xlUp))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HA.BÄæÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Crr(1 To UBound(Brr), 1 To 100)
'¡ô¥O«Å§iCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr°}¦C,¾î¦V¯Á¤Þ¸¹1~100
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!±q1¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   T = Brr(i, 1)
   '¡ô¥OTÅܼƬO i°j°é²Ä1ÄæBrr°}¦C­È
   If Y(T) = "" Then
   '¡ô¦pªGTÅܼƬdY¦r¨åªºitem­È¬O"" ?
      Y(T) = Y.Count
      '¡ô¥OY¦r¨åªºTÅܼÆkeyªºitem­È¬O Y¦r¨åkeyªº¼Æ¶q
      Crr(Y(T) \ 2 + 1, 1) = T
      '¡ô¥OCrr°}¦C©ñ¤JTÅܼÆ
      Y(T & "/C") = 1
      '¡ô¥OTÅܼƳs±µ"/C"²Õ¦¨ªº·s¦r¦ê·íkey,item¬O1,¯Ç¤JY¦r¨å¤¤
   End If
   Y(T & "/C") = Y(T & "/C") + 1
   '¡ô¥OY¦r¨å¤¤(TÅܼƳs±µ"/C"²Õ¦¨¦r¦ê)key,¨äitem­È²Ö¥[1
   '³o¬O­n¦bY¦r¨å¤¤°O¿ýTÅܼÆÄ渹
   Crr(Y(T) \ 2 + 1, Y(T & "/C")) = Brr(i, 2)
   '¡ô¥OCrr°}¦C¦b¾A·í¦ì¸m©ñ¤J i°j°é²Ä2ÄæBrr°}¦C­È
   If Y(T & "/C") > M Then
   '¡ô¦pªGY¦r¨å¤¤°O¿ýTÅܼÆÄ渹¤j©óMÅܼÆ
      M = Y(T & "/C")
      '¡ô´NÅýMÅܼƴ«¸ËÅܼÆÄ渹
      Crr(1, M) = Brr(1, 2)
      '¡ô¥O¦bCrr°}¦C²Ä1¦CMÄ渹¦ì¸m²K¥[¤@­Ó"³¡ªù¦WºÙ"¼ÐÃD
   End If
Next
[E1].Resize(Y.Count \ 2 + 1, M) = Crr
'¡ô¥OCrr°}¦C­È±q[E1]¶}©l¼g¤JÀx¦s®æ¤¤
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub