ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

¦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) ªº)

¦^´_ 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

TOP

¦^´_ 2# c_c_lai


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

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


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

TOP

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

TOP

¦^´_ 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)

TOP

¦^´_ 3# Michelle-W

¸ê®Æ.rar (1.1 MB)

TOP

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

TOP

¦^´_ 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ÁÂ><"

TOP

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





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

TOP

¦^´_ 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. Sub ·s¼W¿ï³æ()
  41.     Dim rng As Range, rng2 As Range
  42.    
  43.     §R°£¤u§@ªí
  44.     With Worksheets("¿ï³æ")
  45.         .Cells.Clear
  46.         Set rng = Sheets("Á`ªí").Range("A2", Sheets("Á`ªí").[A2].End(xlDown))
  47.         .[C1].Resize(, rng.Count - 1) = Application.Transpose(rng)
  48.         Set rng = Sheets("Á`ªí").Range("A16", Sheets("Á`ªí").[B16].End(xlDown))
  49.         rng.Copy .[A1]
  50.     End With
  51. End Sub

  52. Function tblExist(tblName As String) As Boolean
  53.     Dim xi As Integer
  54.    
  55.     tblExist = False
  56.     For xi = 1 To Worksheets.Count
  57.         If Worksheets(xi).Name = tblName Then tblExist = True: Exit Function
  58.     Next xi
  59. End Function

  60. Sub §R°£¤u§@ªí()
  61.     Dim xi As Integer
  62.    
  63.     Application.DisplayAlerts = False
  64.     For xi = Worksheets.Count To 2 Step -1
  65.         If Worksheets(xi).Name <> "Á`ªí" And Worksheets(xi).Name <> "¿ï³æ" Then
  66.             Worksheets(xi).Delete
  67.         End If
  68.     Next xi
  69.     Application.DisplayAlerts = True
  70. End Sub

  71. Sub §R°£¦U¤À­¶()
  72.     §R°£¤u§@ªí
  73.     With Worksheets("¿ï³æ")
  74.         .Range("C2:" & Chr(64 + .[C1].End(xlToRight).Column) & 65535).Clear
  75.     End With
  76. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD