[µo°Ý] ¸ê®Æª½¦VÂà¾î¦V±Æ¦C

Genie

¤£¦n·N«ä¤S¨Ó¸ß°Ý¤F

§Ú±q¸ê®Æ®w§ì¥X¨Óªº¸ê®Æ¦pªþ¥óªº"­ì©l¸ê®Æ"©Ò¥Ü¡@§e²{ªº¬Oª½¦V±Æ¦C
­Y§Ú­n±N¸ê®ÆÂàÅܦ¨ªþ¥ó¤¤"Âà¸m«á"ªº¼Ë¤l
¤£ª¾¬O§_¦³¿ìªk¹F¨ì¡H

¦]¬°§Ú§ì¥X¨Óªº¸ê®Æ¦C¼Æ³£¹F¨ì¤W¸Uµ§
©Ò¥H¬O§Æ±æ¯à¦b·sªº sheet °µÂà¸m¡@¶¶«K«O¯d­ì©l¸ê®Æ¥i¥H°µ°Ñ¦Ò

­Y¥H A Äæ¨Ó·í§@¸s²Õ§@Âà¸m¡@«h A Ä檺"1"¡B"2"¡B"3"¦U¤À§O¬°¤@¸s²Õ
¼ÐÃD´N¥H"1"¡B"2"¡B"3"·í§@¼ÐÃD
­Y¥H B Äæ¨Ó·í§@¸s²Õ§@Âà¸m¡@«h B Ä檺"4"¡B"5"¡B"6"¦A·f°t A Ä檺"1"¡B"2"¡B"3"§@¬°¤@¸s²Õ
¼ÐÃD´N¥H"A-B"¨Ó·í§@¼ÐÃD¡@¦]¦¹¼ÐÃD´N¬O"1-4"¡B"1-5"¡B"1-6"¡B"2-4"¡B2-5"¡B"2-6"¡B"3-4"¡B"3-5"¡B"3-6"

§Æ±æ¥i¥HÀ°À°§Ú¡@ÁÂÁ¡ã

¸ê®Æ.zip (4.42 KB)

¤U¸ü¦¸¼Æ: 35

2013-1-7 11:30

Andy2483

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

°õ¦æ«e:

¤U¸ü (176.89 KB)

2023-4-13 16:13

¿é¤Jµ¡¿é¤J"A":

¤U¸ü (140.75 KB)

2023-4-13 16:13

¿é¤Jµ¡¿é¤J"B":

¤U¸ü (142.13 KB)

2023-4-13 16:14

Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000, 1 To 1), A, Y, strNo1, R&, C%, i&, T1$, T2$, T3$, TT$
Dim xR As Range, Sh1 As Worksheet, Sh2 As Worksheet
strNo1 = InputBox("¿é¤JÄæ¦ìA©ÎB", , "A")
If StrPtr(strNo1) = 0 Or InStr("/A/B/", "/" & strNo1 & "/") = 0 Then Exit Sub
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("­ì©l¸ê®Æ"): Set xR = Sh1.[A1].CurrentRegion: Brr = xR
Set Sh2 = Sheets("Âà¸m«á"): Sh2.UsedRange.Clear
For i = 2 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3)
   TT = Switch(strNo1 = "A", T1, strNo1 = "B", T1 & "-" & T2)
   A = Y(TT)
   If Not IsArray(A) Then A = Crr: C = C + 1: Y(TT & "|c") = C
   R = Y(TT & "|r"): R = R + 1: Y(TT & "|r") = R
   A(R, 1) = T3
   Y(TT) = A
Next
For Each A In Y.keys
   If IsArray(Y(A)) Then
      Sh2.Cells(1, Y(A & "|c")) = "'" & A
      Sh2.Cells(2, Y(A & "|c")).Resize(Y(A & "|r"), 1) = Y(A)
   End If
Next
Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

c_c_lai

¦^´_ 11# Hsieh
¦^´_ 14# Genie
Hsieh ª©¤j·s¦~´r§Ö¡I
¸g´ú¸Õµo²{¦³ÂI¤p·åÒ¯¡A­×§ï¤F¤@ÂI

1. '  s = Application.CountIf(.Range(A, A.End(xlDown)), A)
   
2. s = Application.CountIf(.Range("A" & j, .[A2].End(xlDown)), .Cells(j, "A"))

½Æ»s¥N½X

¹Lµ{¦pªþ¹Ï¡G

¤U¸ü (103.32 KB)

2013-1-8 17:56

Genie

¦^´_ 12# softsadwind


¤@¶}©l Hsieh ¶W¯Åª©¥D´£¨Ñªºµ{¦¡°õ¦æ°_¨Ó·|¦³¤@ÂI°ÝÃD
°õ¦æ¥X¨Óªºµ²ªG¥i¥H¥h¤ñ¹ï­ì©l¸ê®Æ¡@·|µo²{¦³´X­Ó¼Æ­È¬O¨S¦³Âà¸m¦¨¥\ªº¡I

Genie

¦^´_ 11# Hsieh


¨S¿ù¡I¡@¸ê®Æ¶q¨CÄæ³£¤£¦P
¤£¹L³o­Óµ{¦¡¸Ñ¨M¤F³o­Ó°ÝÃD
«D±`ÁÂÁ¡ã

softsadwind

¦^´_ 10# Genie


    §Ú´ú¸Õ°_¨Óªºµ²ªG¬Ookªº»¡....
   

¤U¸ü (76.23 KB)

2013-1-8 16:08

¥t¥~¤@­Ó°ÝÃD­n½Ð±Ð¦U¦ì¤j¤j
·íd1 ªºitem¹L¦hªº®É­Ô
.[A2].Resize(d1.Count, 6) = Application.Transpose(Application.Transpose(d1.items))
¥L¦bÂà´«ªº®É­Ô´N·|¥X²{«¬ºA¤£²Å

¤U¸ü (4.33 KB)

2013-1-8 16:10

¹Á¸Õ§ârow §ï¦b 500¤§¤º¡A´N¥i¥Hª½±µ.[A2].Resize(d1.Count, 6) = Application.Transpose(Application.Transpose(d1.items))

¥u¦n¥Î§Oªº¤è¦¡³B²z
    For Each E In D.items
        
           E.Copy Sheets("Last - N").Range("A" & Rows.Count).End(xlUp).Offset(1)
        
    Next

¤£ª¾¹D¦³¤H¥i¥H«üÂI§ó¤è«Kªº¤è¦¡¶Ü¡H

Hsieh

¦^´_ 10# Genie
¸ê®Æ·|¦³¨CÄ椣¦P¸ê®Æ¶q¶Ü?
¸Õ¸Õ¼g¤J®É¨Ì¦U¸s²Õ¸ê®Æ¶q¼g¤J

1. Sub ex()
   
2. 
   
3. Dim A As Range, d As Object, j&, i%, s%, C$, Ky
   
4. 
   
5. C = InputBox("¿é¤JÄæ¦ìA©ÎB", , "A")
   
6. 
   
7. Set d = CreateObject("Scripting.Dictionary")
   
8. 
   
9. With Sheet1
   
10. 
    
11. j = 2
    
12. 
    
13. Do Until .Cells(j, 1) = ""
    
14. 
    
15.   Set A = .Cells(j, C)
    
16. 
    
17.   s = Application.CountIf(.Range(A, A.End(xlDown)), A)
    
18. 
    
19.   i = Application.CountIf(A.Resize(s, 1), .Cells(j, C)) '­pºâ³æµ§¸ê®Æ¶q
    
20. 
    
21.   If C = "A" Then
    
22. 
    
23.      d(A.Value) = A.Offset(, 2).Resize(i, 1).Value
    
24. 
    
25.      Else
    
26. 
    
27.      d(A.Offset(, -1) & "_" & A) = A.Offset(, 1).Resize(i, 1).Value
    
28. 
    
29.   End If
    
30. 
    
31. j = j + i
    
32. 
    
33. Loop
    
34. 
    
35. End With
    
36. 
    
37. With Sheet2
    
38. 
    
39. .UsedRange.Clear
    
40. 
    
41. k = 1
    
42. 
    
43. For Each Ky In d.keys
    
44. 
    
45.    .Cells(1, k) = Ky
    
46. 
    
47.    .Cells(2, k).Resize(UBound(d(Ky)), 1) = d(Ky)
    
48. 
    
49.    k = k + 1
    
50. 
    
51. Next
    
52. 
    
53. End With
    
54. 
    
55. End Sub

½Æ»s¥N½X

Genie

¦^´_ 8# Hsieh


³o­Óµ{¦¡°õ¦æ°_¨Ó¡@¦³´X­Ó¼Æ¾Ú·|µLªkÂà¸m¦¨¥\
¥B·|¥X²{ ¡­N/A ªºÄæ¦ì
¦p¹Ï¬O¿ï A Äæ¶i¦æÂà¸m
¦b "1" Ä椤¤Ö¤F¤@­Ó¼Æ¾Ú¡@¦b "2" Ä椤¦h¤F #N/A
½Ð°Ý¦³¿ìªk§ïµ½¶Ü¡H
ÁÂÁ¡ã

¤U¸ü (37.81 KB)

2013-1-8 14:16

Genie

¦^´_ 6# GBKEE
¦^´_ 7# c_c_lai


ÁÂÁ¡ã¡@µ{¦¡°õ¦æ°_¨Ó¨S¦³°ÝÃD¡I¡I¡I

¦A½Ð°Ý¡@­Y§Ú­nÂX¥RÄæ¦ì¡@¥Î C Äæ©Î D Äæ§@°Ï¤À
¦³¿ìªk¤p§ï³o­Óµ{¦¡´N°µ±o¨ì¶Ü¡H

ÁöµM¥Ø«e¥Î¤£¨ì¡@¦ý·Q¤F¸Ñ¥¼¨Ó¦³»Ý­n®É§Ú¥i¥H«ç¼Ë°µ§ï¼g
ÁÂÁ¡ã

Hsieh

¦^´_ 1# Genie

1. Sub ex()
   
2. Dim A As Range, d As Object, j&, i%, s%, C$, Ky
   
3. C = InputBox("¿é¤JÄæ¦ìA©ÎB", , "A")
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. With Sheet1
   
6. j = 2
   
7. Do Until .Cells(j, 1) = ""
   
8.   Set A = .Cells(j, C)
   
9.   s = Application.CountIf(.Range(A, A.End(xlDown)), A)
   
10.   i = Application.CountIf(A.Resize(s, 1), .Cells(j, C)) '­pºâ³æµ§¸ê®Æ¶q
    
11.   If C = "A" Then
    
12.      d(A.Value) = A.Offset(, 2).Resize(i, 1).Value
    
13.      Else
    
14.      d(A.Offset(, -1) & "_" & A) = A.Offset(, 1).Resize(i, 1).Value
    
15.   End If
    
16. j = j + i
    
17. Loop
    
18. End With
    
19. With Sheet2
    
20. .UsedRange.Clear
    
21. k = 1
    
22. For Each Ky In d.keys
    
23.    .Cells(1, k) = Ky
    
24.    .Cells(2, k).Resize(i, 1) = d(Ky)
    
25.    k = k + 1
    
26. Next
    
27. End With
    
28. End Sub

½Æ»s¥N½X