[µo°Ý] §ì¨ú¿z¿ï«áÀx¦s®æ¤º®e¦Ü¹ïÀ³ªº¤u§@ªí

Michelle-W

¦U¦ì¦n!~
§Ú¤§«e¦³½Ð±Ð¹L¦Û°Ê§ì¨ú«á­±¦³¼Ðµùªº¤èªk¡A¦ý¨º®É­Ô¸ê®Æ¤ñ¸û¤Ö
²{¦b¸ê®ÆÅܦh¤F
¥Ø«e¦³7¦ì¤H­û(B1:H1)¡A§Ú³£¥Î¬Û¦Pªºµ{¦¡½X½Æ»s¦A½Æ»s
¦ý«áÄòÁÙ·|¼W¥[¤H­û(°²³]B1:K1)¡A§Ú±o¦A¦¸­×§ïµ{¦¡½X
½Ð°Ý¦³¨S¦³¤°»ò¼Ëªº¼gªk¡A¥i¥H¦Û°Ê§ì¨ú(B1:K1)¨ì¹ïÀ³ªº¤u§@ªí¤º
(¦]¬°«áÄòÁÙ¦³¦U­Ó¤ë¥÷»Ý­n·s¼W¤W¥hQQ¡A¤H­ûÀH®É·|¼W¥[¡A¦Ó±MÄݪº¤u§@ªí¸ê®Æ¬O²Ö¥[ªº)


¦A¦¸·PÁ :)
¸ê®Æ.rar (837.08 KB)

¤U¸ü¦¸¼Æ: 10

2016-7-14 15:41

ªº)

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

Michelle-W

¦^´_ 2# c_c_lai


·|¥X²{1004ªº¿ù»~QQ

¤U¸ü (33.1 KB)

2016-7-14 20:59

°»¿ù¤Ï¶Àªº¬O³o¥y
ActiveSheet.Name = lg.Value
³o²Õµ{¦¡½X¤Ó½ÆÂø¤F¡A§ÚÁ٬ݤ£À´>"<


¦b³Â·Ð±zÀ°¦£¬Ý¬Ý
¦A¦¸¦A¦¸ªº·PÁÂ

Kubi

¦^´_ 1# Michelle-W
½Ð°Ñ¦Ò¡C
¸ê®Æ-1.rar (30.43 KB)

¤U¸ü¦¸¼Æ: 9

2016-7-15 13:51

Michelle-W

¦^´_ 4# Kubi


«D±`·PÁ±zªº«üÂI~~
ÁÙ·Q½Ð±Ð¤@¤U...
­Y¬O°²³]BÄæ¥u¬O­n°O¿ý®É¶¡
(¨S¦³±MÄݤu§@ªí¡A¦ý­n³s¦P¸ê®Æ¤@°_¶K¨ì±MÄݪº¤u§@ªí¸Ì­±ªº¸Ü)
¥H³o²Õµ{¦¡½X¦³¿ìªk°µ§ó§ï¶Ü?

¦A¦¸·PÁ :)
¸ê®Æ-2.rar (27.23 KB)

¤U¸ü¦¸¼Æ: 4

2016-7-15 16:30

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

Kubi

¦^´_ 5# Michelle-W
½Ð´ú¸Õ
¸ê®Æ-3.rar (27.11 KB)

¤U¸ü¦¸¼Æ: 8

2016-7-15 20:11

Michelle-W

¦^´_ 6# c_c_lai


ÁÂÁ±zªº«ü¾É~ ^^
³o²Õµ{¦¡½X§Ú¬Ý±o¤ñ¸û¦Y¤O¡A¤ñ¸ûÃø...
±z¦³¯S§Oµù©ú¥u°w¹ï5¤ë¥÷ªº¸ê®Æ
½Ð°Ý¦pªG¦P®É¦³5¤ë»P6¤ëªº¸ê®Æ­n·s¼W¶i¥h±MÄݤu§@ªí¤º¡A
´NµLªk¨Ï¥Î©Î­×§ï³o²Õµ{¦¡½Xªº¼gªk¹ï¶Ü??
§Ú¦Û¤v¶Ã§ï¡A¸ê®Æ³£·|³QÂл\¡A¥uÅã¥Ü6¤ëªº¸ê®Æ QQ
¦pªG¥i¥Hªº¸Ü¡A¦A³Â·Ð±z«üÂI¤@¤U
·PÁÂ><"

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