c_c_lai

¦^´_ 19# Hsieh

1. Sub ex()                     '  Hsieh
   
2.     Dim ar(0 To 1), ay(), txt$, rng As Range, cts As Integer
   
3.    
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.    
   
6.     With Sheets("·JÁ`ªí")
   
7.         For Each a In .Range(.[B2], .[B2].End(xlDown))
   
8.             If IsEmpty(d(a & "")) Then
   
9.                 ar(0) = Array(.[B1], .[C1], .[D1], .[E1])
   
10.                 ar(1) = Application.Transpose(Application.Transpose(a.Resize(, 4).Value))
    
11.                 d(a & "") = ar      '  a & "" §Yµ¥©ó CStr(a)¡C ±N a : Variant Âà´«¬° String «¬ºA
    
12.             Else
    
13.                 ay = d(a & "")
    
14.                 s = UBound(ay)
    
15.                 ReDim Preserve ay(s + 1)
    
16.                 ay(s + 1) = Application.Transpose(Application.Transpose(a.Resize(, 4).Value))
    
17.                 d(a & "") = ay
    
18.                 Erase ay
    
19.             End If
    
20.             '  d(CStr(a)) = Array(d(CStr(a)), a.Resize(, 4).Value)
    
21.             '  a & "" §Yµ¥©ó CStr(a)¡C ±N a : Variant Âà´«¬° String «¬ºA
    
22.         Next     '  d.Count = 3 : Variant/Long
    
23.         
    
24.         For Each sh In Sheets    '  sh : Variant/Object/¤u§@ªí1/¤u§@ªí8
    
25.             If sh.Name <> "·JÁ`ªí" And d.exists(sh.Name) = True Then
    
26.                 ay = d(sh.Name)
    
27.                
    
28.                 '  sh.[B1].Resize(UBound(ay) + 1, 4) = Application.Transpose(Application.Transpose(ay))
    
29.                 '  ª½¦æ¦Ü¤W¤@¦æ«h²£¥Í ¡y°õ¦æ¶¥¬q¡G 13 ¡u«¬ºA¤£²Å¡v¡z¡A¬G§ï¥H¤U¦C»yªk³B¸Ì¡G
    
30.                 Set rng = sh.[B1]
    
31.                 Sheets("·JÁ`ªí").[B1:E1].Copy rng
    
32.                 For cts = 1 To UBound(ay)
    
33.                     rng.Offset(cts).Resize(1, 4) = Application.Transpose(Application.Transpose(ay(cts)))
    
34.                 Next cts
    
35.                 d.Remove sh.Name
    
36.             End If
    
37.         Next               '  d.Count = 0 : Variant/Long
    
38.         
    
39.         For Each ky In d.keys
    
40.             With Sheets.Add(after:=Sheets(Sheets.Count))
    
41.                 .Name = ky
    
42.                 ay = d(ky)
    
43.                
    
44.                 '  .[B1].Resize(UBound(ay) + 1, 4) = Application.Transpose(Application.Transpose(ay))
    
45.                 '  ª½¦æ¦Ü¤W¤@¦æ«h²£¥Í ¡y°õ¦æ¶¥¬q¡G 13 ¡u«¬ºA¤£²Å¡v¡z¡A¬G§ï¥H¤U¦C»yªk³B¸Ì¡G
    
46.                 Set rng = .[B1]
    
47.                 Sheets("·JÁ`ªí").[B1:E1].Copy rng
    
48.                 For cts = 1 To UBound(ay)
    
49.                     rng.Offset(cts).Resize(1, 4) = Application.Transpose(Application.Transpose(ay(cts)))
    
50.                 Next cts
    
51.             End With
    
52.         Next
    
53.     End With
    
54. End Sub

½Æ»s¥N½X

c_c_lai

¦^´_ 19# Hsieh
²×©ó§ì¨ì°ÝÃDÄpµ²¤F¡A³s¹ÚºÎ¤¤¤]¦b±Ì´e¡C

1. ar(0) = Array(.[B1], .[C1], .[D1], .[E1])

½Æ»s¥N½X

.[B1] ¶Ç¤Jªº¬O Range ª«¥ó¡A¦Ó«D¦r¦ê¡F ¬G·|³y¦¨ ¡y°õ¦æ¶¥¬q¡G 13 ¡u«¬ºA¤£²Å¡v¡z¡A¬G§ï¥H¤U¦C»yªk³B¸Ì¡G

1. ar(0) = Array(.[B1].Value & "", .[C1].Value, .[D1].Value, .[E1].Value)

½Æ»s¥N½X

¨ä¥¦¤º®eºû«ù¤£ÅÜ¡C

1. Sub ex()                     '  Hsieh
   
2.     Dim ar(0 To 1), ay()
   
3.    
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.    
   
6.     With Sheets("·JÁ`ªí")
   
7.         For Each a In .Range(.[B2], .[B2].End(xlDown))
   
8.             If IsEmpty(d(a & "")) Then
   
9.                 '  ar(0) = Array(.[B1], .[C1], .[D1], .[E1])
   
10.                 '  .[B1] ¶Ç¤Jªº¬O Range ª«¥ó¡A¦Ó«D¦r¦ê¡F ¬G·|³y¦¨ ¡y°õ¦æ¶¥¬q¡G 13 ¡u«¬ºA¤£²Å¡v¡z¡A¬G§ï¥H¤U¦C»yªk³B¸Ì¡G
    
11.                 ar(0) = Array(.[B1].Value & "", .[C1].Value, .[D1].Value, .[E1].Value)
    
12.                 ar(1) = Application.Transpose(Application.Transpose(a.Resize(, 4).Value))
    
13.                 d(a & "") = ar      '  a & "" §Yµ¥©ó CStr(a)¡C ±N a : Variant Âà´«¬° String «¬ºA
    
14.             Else
    
15.                 ay = d(a & "")
    
16.                 s = UBound(ay)
    
17.                 ReDim Preserve ay(s + 1)
    
18.                 ay(s + 1) = Application.Transpose(Application.Transpose(a.Resize(, 4).Value))
    
19.                 d(a & "") = ay
    
20.                 Erase ay
    
21.             End If
    
22.         Next
    
23.         
    
24.         For Each sh In Sheets  
    
25.             If d.exists(sh.Name) = True Then
    
26.                 ay = d(sh.Name)
    
27.                 sh.Cells.Clear
    
28.                
    
29.                 sh.[B1].Resize(UBound(ay) + 1, 4) = Application.Transpose(Application.Transpose(ay))
    
30.                 d.Remove sh.Name
    
31.             End If
    
32.         Next               '  d.Count = 0 : Variant/Long
    
33.         
    
34.         For Each ky In d.keys
    
35.             With Sheets.Add(after:=Sheets(Sheets.Count))
    
36.                 .Name = ky
    
37.                 ay = d(ky)
    
38.                
    
39.                 .[B1].Resize(UBound(ay) + 1, 4) = Application.Transpose(Application.Transpose(ay))
    
40.             End With
    
41.         Next
    
42.     End With
    
43. End Sub

½Æ»s¥N½X

¤d·u´M

¦^´_ 13# ­ã´£³¡ªL
½Ð°Ý­ã¤j,²Ä1¦¸¤Î²Ä2¦¸°j°é³£¬O¸I¨ì¬Û¦PªºA³o­Ó­È,²z¸Ñ¦p¤U:
²Ä1¦¸(A,­»¿¼..)°j°é®É,´N¿z¿ï©Ò¦³Aªº¸ê®Æ¤Î¶K¦b¤@­Ó¦WºÙ¬°Aªº¤u§@ªí(·s¼Wªºªí),²Ä2¦¸°j°é®É¸I¨ì(A,»ñ±ù..)®É,¤´·|­«°µ¤u§@ªí©R¦W(§Y«K­ì¨Ó¦WºÙ´N¥sA,§ï¦W«á¤´¬O¥sA,¦ý¤Ö¤F·s¼W¤u§@ªíªº°Ê§@),¤Î²M°£¤u§@ªíAªº¥ý«eªº¤º®e,©³¤Uªº»yªk¦A­«§@¿z¿ï¤Î«áÄò¶K¤W¿z¿ïµ²ªGªº°Ê§@(§Y«K²Ä2¦¸ªºµ²ªG©M²Ä1¦¸³£·|¬O¬Û¦Pªº),¤£ª¾¹D¹ï¤£¹ï!

¤d·u´M

©çÁÂ!¦]¬°¤£¤p¤ßÆp¶i¦º«Ñ,¨S¦³§»Æ[¥þ³¡»y¥y,°Ý¤F¤@­Ó²Â°ÝÃD,­ì¨ÓInStr(TT & "/", "/" & T & "/") Then GoTo 101³o¥y»yªk´N¯àÁ׶}­«ÂЭȪº§@¥Î.

­ã´£³¡ªL

¦^´_ 24# ¤d·u´M


«¢¡I³o¬O¥[²`°O¾Ðªº¤èªk¡A
¾Çvba¡A±q¿ù»~¤¤¥h­×¥¿¡A¬O¦n¤èªkªº¡I¡I¡I

c_c_lai

¦^´_ 24# ¤d·u´M
³o¬O§Úªº§@·~¤ß±o³ø§i¡A©Î³\¯àÀ°§U§A¶i¤@¨B¤§¤F¸Ñ¡A
±N¥¦¶K¤W´£¨Ñ°Ñ¦Ò¡A¦b¦¹½gijÃD¤¤§Úı±o­ã¤jªº¸ÑÃD
¥Ó½×«D±`¤§´Î¡A³æ¤M¤Á¤Jª½±µ¤F·í¡A¤@´ª§Y¦¨¡C
¦b¦¹¥ç·PÁ ­ã´£³¡ªLª©¤j ªº¤£§[«ü¾É¡C

1. '  ¿z¿ïªk¡I¡I¡I      ­ã´£³¡ªL
   
2. '  ¨Ï¥Î¦¹¤èªk "·JÁ`ªí" ¤§ªì©l¤º®e¤£¶·¥ý¦æ±Æ§Ç (Sorting)¡A¥ç§Y¦b«O«ù­ì©lª¬ªp¤Uª½±µ¶i¦æ¿z¿ï³B¸Ì
   
3. Sub ex2()
   
4.     Dim xArea As Range, i&, T$, TT$, Sht As Worksheet
   
5.    
   
6.     With Sheets("·JÁ`ªí")
   
7.         .Select
   
8.         Set xArea = .Range([B1], Cells(Rows.Count, "B").End(xlUp)(1, 4))
   
9.         '  xArea : Range/Range  :  xArea.Address = "$B$1:$E$7" :  String
   
10.     End With
    
11.    
    
12.     For i = 2 To xArea.Rows.Count         '  xArea.Rows.Count : 7 : Long,  xArea.DataSeries : True : Variant/Boolean
    
13.         T = xArea(i, 1): Set Sht = Nothing           '  i = 2 : Long
    
14.         '  -------------------------------------------------------------------------
    
15.         '  ¬°Æ[¹î InStr(TT & "/", "/" & T & "/") ¥H¤Î TT = TT & "/" & T ªº³B²z¤è¦¡¡A
    
16.         '  ¯S±N "·JÁ`ªí" ¤º®e¤§¶¶§Ç¨Æ¥ý¹w§@½Õ¾ã¦p¤U¡A¥H¤è«K°»´ú TT ¹Lµ{¤¤§êºtªº¨¤¦â¡C
    
17.         '  -------------------------------------------------------------------------
    
18.         '  2(i) : xArea(i, 1) = "A" :  xArea(i, 2) = "­»¿¼" :  xArea(i, 3) = 10 :  xArea(i, 4) = 100 : Variant/Object/Range
    
19.         '  3(i) : xArea(i, 1) = "B" :  xArea(i, 2) = "«C´Ô" :  xArea(i, 3) = 50 :  xArea(i, 4) = 500 : Variant/Object/Range
    
20.         '  4(i) : xArea(i, 1) = "A" :  xArea(i, 2) = "¸²µå" :  xArea(i, 3) = 30 :  xArea(i, 4) = 300 : Variant/Object/Range
    
21.         '  5(i) : xArea(i, 1) = "B" :  xArea(i, 2) = "»ñ±ù" :  xArea(i, 3) = 40 :  xArea(i, 4) = 400 : Variant/Object/Range
    
22.         '  6(i) : xArea(i, 1) = "C" :  xArea(i, 2) = "ªÝ¼Ö" :  xArea(i, 3) = 60 :  xArea(i, 4) = 600 : Variant/Object/Range
    
23.         '  7(i) : xArea(i, 1) = "A" :  xArea(i, 2) = "Ä«ªG" :  xArea(i, 3) = 20 :  xArea(i, 4) = 200 : Variant/Object/Range
    
24.         
    
25.         If T = "" Or InStr(TT & "/", "/" & T & "/") Then GoTo 101
    
26.         '  ----------------------------------------------------------------------------------------------
    
27.         '  2(i) : TT & "/" = "/" : "/" & T & "/" = "/A/" : InStr(TT & "/", "/" & T & "/")           = 0 : Long
    
28.         '  3(i) : TT & "/" = "/A" : "/" & T & "/" = "/B/" : InStr(TT & "/", "/" & T & "/")         = 0 : Long
    
29.         '  4(i) : TT & "/" = "/A/B" : "/" & T & "/" = "/A/" : InStr(TT & "/", "/" & T & "/")     = 1 : Long
    
30.         '  5(i) : TT & "/" = "/A/B" : "/" & T & "/" = "/B/" : InStr(TT & "/", "/" & T & "/")     = 1 : Long
    
31.         '  6(i) : TT & "/" = "/A/B" : "/" & T & "/" = "/C/" : InStr(TT & "/", "/" & T & "/")     = 0 : Long
    
32.         '  7(i) : TT & "/" = "/A/B/C" : "/" & T & "/" = "/A/" : InStr(TT & "/", "/" & T & "/") = 1 : Long
    
33.         '  ----------------------------------------------------------------------------------------------
    
34.         '  InStr(TT & "/", "/" & T & "/") ªº·N«ä¬°·í²Ä¤@¦¸Åª¨ú¹Lªº¤u§@ªí¦WºÙ·|¼g¤J¨ìÅÜ¼Æ TT ªº¦r¦ê¤¤,
    
35.         '  ¦]¬°¤w¸g°µ¹L¿z¿ï¤F, ©Ò¥H·í¦A¦¸Åª¨ú¨ì´¿°O¿ý¹Lªº¦WºÙ®É¸õ¹L, ¦Ó "/"  «h¬O­n°Ï¤À¦U¤u§@ªí¦Wªº°Ï¹j¡A
    
36.         '  ¤£·|­«ÂСAÅý InStr ®e©ö§PÂ_¡A¦Ó¤£·|²£¥Í¿ù»~ªº§PÂ_¡F
    
37.         '  InStr(TT & "/", "/" & T & "/")¡@¥Î "/' ¤À¹j¥i¥H²M·¡¤À§O A, AA, AAA ©Î A1, A11, A111¡A¦Ó¤£·|»~§P¡I
    
38.         '  ¦Ó¥B²z½×¤W, ¤u§@ªí¦WºÙ¤£·|¦³ "/" ¦r¤¸¡A­Y¥Î¨ä¥¦²Å¸¹¡A´N­n¦Ò¼{¤u§@ªíªí¦WºÙ¬O§_§t¦³³o­Ó²Å¸¹¡A
    
39.         '  ¨Ò¦p¡G ¥Î "-" ¤À¹j¡A´N¥i¯à¹ï 1-1, 1-11, 1-111  ³y¦¨¬Û¦ü¤u§@ªí¦WºÙ¤§»~§P¡I¡I
    
40.         '  ----------------------------------------------------------------------------------------------
    
41.         On Error Resume Next
    
42.         
    
43.         Set Sht = Sheets(T)
    
44.         On Error GoTo 0
    
45.         
    
46.         If Sht Is Nothing Then Set Sht = Sheets.Add(after:=Sheets(Sheets.Count)): Sht.Name = T   '  Sht ¤£¦s¦b
    
47.         Sht.UsedRange.Clear
    
48.         
    
49.         With xArea
    
50.             .Parent.Select     ' xArea.Parent.Name = "·JÁ`ªí" : Variant/String
    
51.             .AutoFilter Field:=1, Criteria1:=T   ' T = "A" : T = "B" :  T = "C" : String
    
52.             '  AutoFilter ·|¨Ì¾Ú Criteria1 ªº±ø¥ó¶×¶°¡A¼ÐÃD¦ì¸m¨Ã¤£·|²§°Ê
    
53.             .Copy Sht.[B1]                 '  ¥]§t¼ÐÃD»P¤º®e¤@¤@½Æ»s¨ì "A"¡B"B"¡B"C" ¦U§Oªº¤u§@ªí³æ¤º
    
54.         End With
    
55.         
    
56.         TT = TT & "/" & T       '  TT = "/A" : TT = "/A/B" :  TT = "/A/B/C" ¡G String  (§PÂ_¦r¦ê TT ³v¤@¼W¥[)
    
57. 101:
    
58.     Next i
    
59.    
    
60.     ActiveSheet.AutoFilterMode = False         '  ¦^´_¨ì­ì©l³Ìªìªº "·JÁ`ªí" ¤§±Æ§Ç«e¤º®e¶¶§Ç
    
61. End Sub

½Æ»s¥N½X

¤d·u´M

¦^´_ 26# c_c_lai
·PÁÂC_C_LAI¤j¤j´£¨Ñ¸ÔºÉªºµ§°O,³o¼Ë§ó¯à²M·¡­ã¤jªº»yªkºë§®©Ò¦b!

c_c_lai

¦^´_ 27# ¤d·u´M
¥t¤@ºØ¼¶¼g¤è¦¡¡G ¤£¨Ï¥Î GoTo 101 ªº¤èªk
¦]¦­´Á¦b¼¶¼g¤K¦ì¤¸¡B¤Î¤Q¤»¦ì¤¸µ{¦¡®É
(¥]§t Digital Research ªº CBasic)¡A´X¥G
ºÉ¶qÁקK¥h¨Ï¥Î  GoTo Syntax¡A§Ú§Q¥Î­ã¤j
ªº²{¦¨µ{¦¡¨Ó§ï¼g¦¨¦p¤U¡A½Ð°Ñ¦Ò¨Ï¥Î¤è¦¡¡G

1.     For i = 2 To xArea.Rows.Count
   
2.         T = xArea(i, 1): Set Sht = Nothing
   
3.         
   
4.         '  If T = "" Or InStr(TT & "/", "/" & T & "/") Then GoTo 101
   
5.         If T <> "" And InStr(TT & "/", "/" & T & "/") = 0 Then
   
6.             '
   
7.             '
   
8.             '
   
9.             '
   
10.             '
    
11.             '
    
12.             TT = TT & "/" & T
    
13.         End If   '  ª½±µ¨Ï¥Î If Then ~ End If ªº³B²z¼Ò¦¡
    
14. '  101:          '  ±N¥¦§ï¦¨ªþµù
    
15.     Next i

½Æ»s¥N½X