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

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

Genie

¦^´_ 11# Hsieh


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

Genie

¦^´_ 12# softsadwind


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

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

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