c_c_lai

¦^´_ 1# Michelle-W
¸Õ¸Õ¬Ý¡I

1. Sub Ex()
   
2.     Dim lg As Variant, ctn As Variant, xi As Integer
   
3.     Dim dic As Object, sp As Variant, sh As Worksheet
   
4.    
   
5.     Set sh = Worksheets("05¤ë")
   
6.     Set dic = CreateObject("scripting.dictionary")
   
7.    
   
8.     With sh
   
9.         For Each lg In .Range("B1:I1")
   
10.             .Select
    
11.             
    
12.             dic(lg.Value) = ""
    
13.             For Each ctn In .Range("A2:A7")
    
14.                 If ctn.Offset(, lg.Column - 1) = "V" Then
    
15.                     dic(lg.Value) = dic(lg.Value) + IIf(dic(lg.Value) = "", "", ",") + ctn.Value
    
16.                 End If
    
17.             Next
    
18.             sp = Split(dic(lg.Value), ",")
    
19.             '  Cells(15, lg.Column).Resize(UBound(sp) + 1) = Application.Transpose(Array(sp))    '  ®i¥Ü¥Î
    
20.             
    
21.             For xi = 1 To Worksheets.Count
    
22.                 If Worksheets(xi).Name = lg.Value Then Worksheets(xi).Select: Exit For
    
23.             Next xi
    
24.             If xi > Worksheets.Count Then
    
25.                  Sheets.Add After:=Sheets(Worksheets.Count)
    
26.                  ActiveSheet.Name = lg.Value
    
27.             End If
    
28.             With Worksheets(lg.Value)
    
29.                 .[A1] = sh.[A1]
    
30.                 .[B1] = lg.Value
    
31.                 .[A2].Resize(UBound(sp) + 1) = Application.Transpose(Array(sp))
    
32.                 .[B2].Resize(UBound(sp) + 1) = "V"
    
33.             End With
    
34.         Next
    
35.     End With
    
36. End Sub

½Æ»s¥N½X

c_c_lai

¦^´_ 3# Michelle-W

¤U¸ü (55.19 KB)

2016-7-15 18:14

¸ê®Æ.rar (1.1 MB)

¤U¸ü¦¸¼Æ: 2

2016-7-15 18:15

c_c_lai

¦^´_ 8# Michelle-W
½Ð°Ñ¦Ò¡I

¤U¸ü (49.64 KB)

2016-7-18 20:31

¤U¸ü (54.83 KB)

2016-7-18 20:31

¤U¸ü (45.38 KB)

2016-7-18 20:32

¤U¸ü (33.32 KB)

2016-7-18 20:32

¦U¦Û¤ÀÃþ¸ê®Æ.rar (33.09 KB)

¤U¸ü¦¸¼Æ: 5

2016-7-18 20:33

c_c_lai

¦^´_ 8# Michelle-W

1. Sub ¦U¦Û¤ÀÃþ()
   
2.     Dim lg As Variant, ctn As Variant, xi As Boolean
   
3.     Dim dic As Object, sp As Variant
   
4.     Dim sh As Worksheet, wks As Worksheet
   
5.    
   
6.     Set sh = Worksheets("¿ï³æ")
   
7.     Set dic = CreateObject("scripting.dictionary")
   
8.    
   
9.     With sh
   
10.         For Each lg In .Range("C1", .Range("C1").End(xlToRight))
    
11.             .Select
    
12.             
    
13.             dic(lg.Value) = ""
    
14.             For Each ctn In .Range("A2", Range("A2").End(xlDown))
    
15.                 If ctn.Offset(, lg.Column - 1) = "V" Then
    
16.                     dic(lg.Value) = dic(lg.Value) + IIf(dic(lg.Value) = "", "", ",") + ctn.Value
    
17.                 End If
    
18.             Next
    
19.             If dic(lg.Value) <> "" Then
    
20.                sp = Split(dic(lg.Value), ",")
    
21.                 Cells(15, lg.Column).Resize(UBound(sp) + 1) = Application.Transpose(Array(sp))    '  ®i¥Ü¥Î
    
22.                
    
23.                 xi = tblExist(lg.Value)      '  §PÂ_ªí³æ¬O§_¦s¦b
    
24.                 If xi = False Then
    
25.                     Sheets.Add After:=Sheets(Worksheets.Count)
    
26.                     ActiveSheet.Name = lg.Value
    
27.                 End If
    
28.                
    
29.                 With Worksheets(lg.Value)
    
30.                     .Cells.Clear
    
31.                     .[A1] = sh.[A1]
    
32.                     .[B1] = lg.Value
    
33.                     .[A2].Resize(UBound(sp) + 1) = Application.Transpose(Array(sp))
    
34.                     .[B2].Resize(UBound(sp) + 1) = "V"
    
35.                 End With
    
36.             End If
    
37.         Next
    
38.     End With
    
39. End Sub
    
40. 
    
41. Sub ·s¼W¿ï³æ()
    
42.     Dim rng As Range, rng2 As Range
    
43.    
    
44.     §R°£¤u§@ªí
    
45.     With Worksheets("¿ï³æ")
    
46.         .Cells.Clear
    
47.         Set rng = Sheets("Á`ªí").Range("A2", Sheets("Á`ªí").[A2].End(xlDown))
    
48.         .[C1].Resize(, rng.Count - 1) = Application.Transpose(rng)
    
49.         Set rng = Sheets("Á`ªí").Range("A16", Sheets("Á`ªí").[B16].End(xlDown))
    
50.         rng.Copy .[A1]
    
51.     End With
    
52. End Sub
    
53. 
    
54. Function tblExist(tblName As String) As Boolean
    
55.     Dim xi As Integer
    
56.    
    
57.     tblExist = False
    
58.     For xi = 1 To Worksheets.Count
    
59.         If Worksheets(xi).Name = tblName Then tblExist = True: Exit Function
    
60.     Next xi
    
61. End Function
    
62. 
    
63. Sub §R°£¤u§@ªí()
    
64.     Dim xi As Integer
    
65.    
    
66.     Application.DisplayAlerts = False
    
67.     For xi = Worksheets.Count To 2 Step -1
    
68.         If Worksheets(xi).Name <> "Á`ªí" And Worksheets(xi).Name <> "¿ï³æ" Then
    
69.             Worksheets(xi).Delete
    
70.         End If
    
71.     Next xi
    
72.     Application.DisplayAlerts = True
    
73. End Sub
    
74. 
    
75. Sub §R°£¦U¤À­¶()
    
76.     §R°£¤u§@ªí
    
77.     With Worksheets("¿ï³æ")
    
78.         .Range("C2:" & Chr(64 + .[C1].End(xlToRight).Column) & 65535).Clear
    
79.     End With
    
80. End Sub

½Æ»s¥N½X

c_c_lai

¦^´_ 8# Michelle-W
§Ú¦³ÂI¦n©_§A·Q¹³¤§¾ãÅé§@·~ªº¬yµ{¹ê»Ú¬O¦p¦ó¶i¦æªº¡H
¦pªG¦P®É¦³5¤ë»P6¤ëªº¸ê®Æ­n·s¼W¶i¥h±MÄݤu§@ªí¤º¡A
¤S¬O«ç»¡¡H

c_c_lai

¦^´_ 12# Michelle-W

¤U¸ü (68.79 KB)

2016-7-19 10:56

c_c_lai

¦^´_ 14# Michelle-W
¬O¤£¬O³o¼Ë¡H
¦U¦Û¤ÀÃþ¸ê®Æ.rar (30.73 KB)

¤U¸ü¦¸¼Æ: 8

2016-7-19 13:05

¤U¸ü (62.91 KB)

2016-7-19 13:12