[µo°Ý] vbaªº¿z¿ï¥\¯à (¨ú®ø³¡¤À¿z¿ï)

wei9133

¦p¦ó¨ú®ø³¡¤À¤w³Q¿z¿ïªº¿ï¶µ
¿z¿ïÁ`¦@¤À¦¨«e«á°Ï¬q¡A¤À§O¬O1~49 & 51~99¡A50ªº¦ì¸m¬O¤¤¶¡¤À®æ
»Ý¨D¬O¦b¤£¼vÅT51~99³Q¿z¿ïªº³¡¤À¡A±N1~49¥þ³¡§ï¬°"¥þ³¡"´N¬O­ì©l¥¼¿z¿ïªºª¬ºA¡A¤Ï¤§¥çµM¡C

sub ¿z¿ï«eºÝ  ()
Dim var_min, var_max,i, j, s As Integer
var_min = 1  '«e¥b¬q°_
var_max = 49 '«e¥b¬q¨´
For i = var_min To var_max
i = i + 1
Selection.AutoFilter Field:=i
Next i
End Sub

sub ¿z¿ï«áºÝ  ()
Dim var_min, var_max,i, j, s As Integer
var_min = 51  '«á¥b¬q°_
var_max = 99  '«á¥b¬q¨´
For i = var_min To var_max
i = i + 1
Selection.AutoFilter Field:=i
Next i
End Sub

¥Ñ¿ý»s¥i¥H±o¨ì¡A¤@¯ëªº¿z¿ï«ü¥O¬O
Selection.AutoFilter Field:=5, Criteria1:="W" '±N²Ä5Äæ¿z¿ï¬°W
¦ý¬O¿ï¾Ü¨ú®ø¸ÓÄæ¦ìªº¿z¿ï¡A¿ï¾Ü¥þ³¡«h¥u·|¬O
Selection.AutoFilter Field:=i
'±q¿ý»s¬Ý°_¨Ó¨S¦³µ¹«á­±³o¦ê«ü©w­È´N¬O¥þ³¡¤F
'±N¸Ó®æ¿z¿ï¬°"¥þ³¡"

©Ò¥H¦³¤F¤W­±ªºµ{¦¡½X¡A¦ý¬Ý°_¨Ó¬O¨S¦³®ÄªGªº¡C
·Q½Ð°Ý¨ú®ø¿z¿ïªº«ü¥O¬O? (Criteria1:= ?)
ÁÙ¦³¦pªG¤£¥Î°j°é¦³ª½±µ¿ï¨ú½d³òªº¤èªk¶Ü?
©Î¬O¥u¯à¥Î°j°é¡A¦³¥Î¤å¦r¦Ó«DÄæ¦ì¼Æªº¤èªk?
¹³¥Ø«e1~49¨ä¹ê¬OA~AX¡A51~99¨ä¹ê¬OAY~CU
¥i¥Hª½±µ«ü©w¤å¦r¤U¥h°j°é¶Ü?
²¦³ºª½±µ¬Ý¨ìªº¬O¤å¦r¡A¤ñ¦A¥h´«ºâ¼Æ¦rª½Æ[¡C

°a¤ªºµ

¦^´_ 59# wei9133

­è¤~¸Õ¤F¤@¤Uµo²{ 106¬P¶H¦³°ÝÃD §ï¤F¤@¤U  ¡A¦³ªÅ¦AÀ°§Ú¸Õ¸Õ¬Ý ¦³¨S¦³°ÝÃD¡A·PÁÂ

javascript:;

°a¤ªºµ

¦^´_ 59# wei9133

³o·|¤ñ¸û§Ö¤@ÂI ¦ý¬OÁÙ¬O«ÜºC... ¦³ªÅÀ°§Ú¸Õ¸Õ¬Ý¦³¨S¦³°ÝÃD   ·PÁÂ

1. Public Sub ½m²ß1118()
   
2. Sheets(2).Select
   
3. Rows(2).Select
   
4. ActiveWindow.FreezePanes = False
   
5. Application.ScreenUpdating = False
   
6. Sheets(2).[A1].CurrentRegion.Clear
   
7. Sheets(1).Select
   
8. Dim Arr, D, xD, x&, y&, k&, T1$, T3$, E()
   
9. Set xD = CreateObject("Scripting.Dictionary")
   
10. Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
    
11. For x = 2 To UBound(Arr, 1)
    
12.     T1 = ""
    
13.     For y = 1 To 51
    
14.         T1 = T1 & Arr(x, y)
    
15.         If Arr(x, y) = "" Then T1 = T1 & "|"
    
16.     Next y
    
17.     T3 = ""
    
18.     For y = 52 To 102
    
19.         T3 = T3 & Arr(x, y)
    
20.         If Arr(x, y) = "" Then T3 = T3 & "|"
    
21.     Next y
    
22.     T1 = T1 & T3 & Arr(x, 106)
    
23.     ReDim Preserve E(x)
    
24.     E(x) = T1
    
25.     T3 = ""
    
26.     If Arr(x, 103) = "" Then
    
27.         Arr(x, 103) = 1
    
28.         xD(T1) = xD(T1) + Arr(x, 103)
    
29.     ElseIf Arr(x, 103) <> "" Then
    
30.         xD(T1) = xD(T1) + Arr(x, 103) + 1
    
31.     End If
    
32.     xD(T1 & 105) = xD(T1 & 105) + Arr(x, 105)
    
33.     xD(Arr(x, 106)) = xD(Arr(x, 106)) + 1
    
34. Next x
    
35. T1 = "": k = 2
    
36. For Each D In xD
    
37.     For x = 2 To UBound(Arr, 1)
    
38.         If D = E(x) Then
    
39.             Arr(x, 103) = xD(D) - 1
    
40.             Arr(x, 105) = xD(D & 105)
    
41.             If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
    
42.             Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
    
43.                  For y = 1 To UBound(Arr, 2)
    
44.                      Arr(k, y) = Arr(x, y)
    
45.                  Next y
    
46.             k = k + 1
    
47.             Exit For
    
48.             End If
    
49.         End If
    
50.         If D = E(x) And xD(D) = 1 _
    
51.         And Arr(x, 107) = "" And Arr(x, 109) = "" _
    
52.         And Arr(x, 115) = "" And Arr(x, 104) = "" Then
    
53.             For y = 1 To UBound(Arr, 2)
    
54.                 Arr(k, y) = Arr(x, y)
    
55.             Next y
    
56.         k = k + 1
    
57.         Exit For
    
58.         End If
    
59.     Next x
    
60. If Arr(k - 1, 103) = 0 Then Arr(k - 1, 103) = ""
    
61. If Arr(k - 1, 105) = 0 Then Arr(k - 1, 105) = ""
    
62. Next D
    
63. Set xD = Nothing: Erase E
    
64. Sheets(2).Range("A1").Resize(k - 1, UBound(Arr, 2)) = Arr
    
65. Erase Arr
    
66. Application.ScreenUpdating = True
    
67. Sheets(2).Select
    
68. Rows(2).Select
    
69. ActiveWindow.FreezePanes = True
    
70. Cells(Rows.Count, 106).End(xlUp).Select
    
71. End Sub

½Æ»s¥N½X

°a¤ªºµ

¦^´_ 59# wei9133

¦³ªÅÀ°§Ú¸Õ¸Õ¬Ý  ³o­ÓÀ³¸Ó¥i¥H  ¦ý¬O¦³¤@­Ó«Ü¤jªº°ÝÃD ...¦pªG¸ê®Æ«Ü¦h ·|¶]«D±`ºC....

1. Public Sub ½m²ß1116()
   
2. Sheets(2).Select
   
3. Rows(2).Select
   
4. ActiveWindow.FreezePanes = False
   
5. Application.ScreenUpdating = False
   
6. Sheets(2).[A1].CurrentRegion.Clear
   
7. Sheets(1).Select
   
8. Dim Arr, D, xD, x&, y&, k&, T1$, T2$, T3$, T4$
   
9. Set xD = CreateObject("Scripting.Dictionary")
   
10. Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
    
11. For x = 2 To UBound(Arr, 1)
    
12.     T1 = ""
    
13.     For y = 1 To 51
    
14.         T1 = T1 & Arr(x, y)
    
15.         If Arr(x, y) = "" Then T1 = T1 & "-"
    
16.     Next y
    
17.     T3 = ""
    
18.     For y = 52 To 102
    
19.         T3 = T3 & Arr(x, y)
    
20.         If Arr(x, y) = "" Then T3 = T3 & "-"
    
21.     Next y
    
22.     T1 = T1 & T3 & Arr(x, 106)
    
23.     T3 = ""
    
24.     If Arr(x, 103) = "" Then
    
25.         Arr(x, 103) = 1
    
26.         xD(T1) = xD(T1) + Arr(x, 103)
    
27.     ElseIf Arr(x, 103) <> "" Then
    
28.         xD(T1) = xD(T1) + Arr(x, 103) + 1
    
29.     End If
    
30.     xD(T1 & 105) = xD(T1 & 105) + Arr(x, 105)
    
31.     xD(Arr(x, 106)) = xD(Arr(x, 106)) + 1
    
32. Next x
    
33. T1 = "": k = 2
    
34. For Each D In xD
    
35.     For x = 2 To UBound(Arr, 1)
    
36.         T2 = ""
    
37.         For y = 1 To 51
    
38.             T2 = T2 & Arr(x, y)
    
39.             If Arr(x, y) = "" Then T2 = T2 & "-"
    
40.         Next y
    
41.         T4 = ""
    
42.         For y = 52 To 102
    
43.             T4 = T4 & Arr(x, y)
    
44.             If Arr(x, y) = "" Then T4 = T4 & "-"
    
45.         Next y
    
46.         T2 = T2 & T4 & Arr(x, 106)
    
47.         T4 = ""
    
48.         If D = T2 Then
    
49.             Arr(x, 103) = xD(D) - 1
    
50.             Arr(x, 105) = xD(D & 105)
    
51.             If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
    
52.             Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
    
53.                  For y = 1 To UBound(Arr, 2)
    
54.                      Arr(k, y) = Arr(x, y)
    
55.                  Next y
    
56.             k = k + 1
    
57.             Exit For
    
58.             End If
    
59.         End If
    
60.         If D = Arr(x, 106) And xD(D) = 1 _
    
61.         And Arr(x, 107) = "" And Arr(x, 109) = "" _
    
62.         And Arr(x, 115) = "" And Arr(x, 104) = "" Then
    
63.             For y = 1 To UBound(Arr, 2)
    
64.                 Arr(k, y) = Arr(x, y)
    
65.             Next y
    
66.         k = k + 1
    
67.         Exit For
    
68.         End If
    
69.     Next x
    
70. If Arr(k - 1, 103) = 0 Then Arr(k - 1, 103) = ""
    
71. If Arr(k - 1, 105) = 0 Then Arr(k - 1, 105) = ""
    
72. Debug.Print k
    
73. Debug.Print D
    
74. Next D
    
75. T2 = "": Set xD = Nothing
    
76. Sheets(2).Range("A1").Resize(k - 1, UBound(Arr, 2)) = ""
    
77. Sheets(2).Range("A1").Resize(k - 1, UBound(Arr, 2)) = Arr
    
78. Erase Arr
    
79. Application.ScreenUpdating = True
    
80. Sheets(2).Select
    
81. Rows(2).Select
    
82. ActiveWindow.FreezePanes = True
    
83. Cells(Rows.Count, 106).End(xlUp).Select
    
84. End Sub

½Æ»s¥N½X

°a¤ªºµ

¦^´_ 59# wei9133

¦pªG¥ª¥k¤£¥Î¤ñ¹ï ¨º´Nª½±µ¤ñ¹ï¬P¶H ¦A¶i¦æ³Ó³õ ¸ò ±Ñ³õ ¥[Á`¥i¥H¶Ü?

°a¤ªºµ

¦^´_ 59# wei9133

¥ª¥k¤£¥Î¤ñ¹ï¤F¶Ü?    §Ú§â¥ª¥k¤ñ¹ïµù¸Ñ±¼¤F  ¦³ªÅ§A¦A¸Õ¸Õ¬Ý µ²ªG¬O§_¥i¥H ·PÁÂ


javascript:;

wei9133

¦^´_ 58# °a¤ªºµ


    §A¦n¡A¥Ø«e´ú¸ÕÁÙ¦³¨Ç°ÝÃD¡A³Ó³õ¥[Á`³¡¤À¹ï¤F
¤£¹L¤ñ¹ï³¡¤À¦³¨Ç°ÝÃD¡C
¸Ô²Ó½Ð§A¬Ý¹Ï¤ù

¤U¸ü (9.88 KB)

2020-11-13 03:47

¤U¸ü (11 KB)

2020-11-13 03:47

¤U¸ü (13.08 KB)

2020-11-13 03:47

¤U¸ü (7.27 KB)

2020-11-13 03:47

¤U¸ü (12.98 KB)

2020-11-13 03:47

¤U¸ü (8.46 KB)

2020-11-13 03:47

°ÝÃD±q³o¸Ì¶}©l

¤U¸ü (29.7 KB)

2020-11-13 03:47

¤U¸ü (40.93 KB)

2020-11-13 03:47

¦pªG½×¾Âªº¹Ï¤£¤è«K¬Ýªº¸Ü
³Â·Ð²¾¾r¬Ûï
(½Ð±q³Ì«á¤@±i©¹«e¬Ý)

°a¤ªºµ

¦^´_ 57# wei9133
À°§Ú¬Ý¤@¤U ³oµ²ªG ¥i¤£¥i¥H  ·PÁÂ

javascript:;

wei9133

¦^´_ 56# °a¤ªºµ


  §A¦n¡A²Ê²¤ª½±µ´ú¸Õ§Aµ¹ªºÀɮסA§A¥i¯à¨S¦³¤ñ¹ï¨ì106(¬P¶H)Äæ
ª½±µ±NÀɮ׸ü¦^¡A¨Ã±N¬P¶HÄæ¥H¼Æ¦C¤U©Ô
Åý¨äÅܦ¨1~17¡A°õ¦æ¤§«á²z½×¤W¨ÓÁ¿¡A¦]¬°17­Ó¬P¶H¦ì¸m³£¤£¦P©Ò¥H¦Ü¤ÖÀ³¸Ó­n¦³17¦C

¤U¸ü (15.72 KB)

2020-11-6 22:01

¹ê»Ú®ÄªG«o¬O
¦³¨â­Ó14¡A16¡B17®ø¥¢¡A¥Nªí³o­Ó¦b³o¸Ì¤w¸g¬O¦³°ÝÃDªº¤F

¤U¸ü (13.78 KB)

2020-11-6 22:01

°a¤ªºµ

¦^´_ 55# wei9133

§A¦³·s¼W ¤u§@ªí¶Ü?  ¥Î³o­Ó¸Õ¸Õ¬Ý  
§Ú¦³§â jcchiang«e½úªº¤]©ñ¶i¥h¤F  Sub ex5()  µ²ªG¤£¤Ó¤@¼Ë  
¦A¬Ý¬Ý§Ú­þ¸Ì¦³°ÝÃD¦b§i¶D§Ú ·PÁÂ

javascript:;