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

[µo°Ý] ¨D§U¶ñ¤J±M®×½s¸¹

[µo°Ý] ¨D§U¶ñ¤J±M®×½s¸¹

¤p§Ì¥u·|¼g²³æªºVBA¤Î¿ý»s¥¨¶°,©Ò¥H¨D§U¦U¦ì¥ý¶i, ÁÂÁÂ!

Àɮפº¦³2­Ó¤u§@ªí,¥Í²£»â°h®Æ©ú²Ó¤Î±M®×½s¸¹, »Ý±N±M®×½s¸¹¤u§@ªí¤ºªº±M®×½s¸¹¶ñ¤J¥Í²£»â°h®Æ©ú²Óªí¤º»s¥O³æ¸¹«á­±.

¥»©«³Ì«á¥Ñ GBKEE ©ó 2013-6-10 15:05 ½s¿è

¥[¤J±M®×½s¸¹.rar (45.8 KB)

±M®×½s¸¹.jpg (467.35 KB)

±M®×½s¸¹.jpg

±M®×½s¸¹.jpg (467.35 KB)

±M®×½s¸¹.jpg

±M®×½s¸¹.jpg (467.35 KB)

±M®×½s¸¹.jpg

project.jpg (467.35 KB)

project.jpg

¥[¤J±M®×½s¸¹.JPG (260.43 KB)

¥[¤J±M®×½s¸¹.JPG

TOP

¦^´_ 1# xandertco
¸Õ¸Õ§a
  1. Sub Test()
  2.     Dim r1 As Long, r2 As Long
  3.    
  4.     Application.ScreenUpdating = False

  5.     With Sheets("¥Í²£»â°h®Æ©ú²Óªí")
  6.         r1 = .Cells(.Rows.Count, "A").End(xlUp).Row - 1  '[¦X­p]ªº¤W­±¤@¦C
  7.         
  8.         ' A9 ¨ì A680 ¤¤¬°±`¼Æ¤å¦rªºÀx¦s®æ
  9.         With .Range(.[A9], .Cells(r1, "A")).SpecialCells(xlCellTypeConstants, xlTextValues)
  10.             For Each x In .Cells
  11.                 '¹ï«D»s¥O³æ¸¹ªº¦C
  12.                 If x.Value <> "»s¥O³æ¸¹" Then
  13.                     With Sheets("±M®×½s¸¹")
  14.                         .AutoFilterMode = False '¨ú®ø¦Û°Ê¿z¿ï
  15.                         r2 = .Cells(.Rows.Count, "A").End(xlUp).Row     '¥HAÄæ§ä³Ì¤j¦C¼Æ
  16.                         .Range("A1:B" & r2).AutoFilter Field:=1, Criteria1:=x.Value     '¥Hx³æ¸¹¥h¿z¿ï
  17.                         .Range("B2:B" & r2).SpecialCells(xlCellTypeVisible).Copy        '½Æ»sBÄæ¥i¨£Äæ
  18.                     End With
  19.                     x.Offset(, 16).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True   'Âà¸m¶K¤W¨ìQÄæ¥k¤è
  20.                 End If
  21.             Next
  22.         End With
  23.     End With
  24.    
  25.     Application.ScreenUpdating = True
  26. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# xandertco
  1. Sub ¶ñ¤J()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With Sheets("±M®×½s¸¹")
  4.    ar = .Range("A1").CurrentRegion.Value
  5.    For i = 2 To UBound(ar, 1)
  6.       d(ar(i, 1)) = IIf(d(ar(i, 1)) = "", ar(i, 2), d(ar(i, 1)) & "," & ar(i, 2))
  7.    Next
  8. End With
  9. With Sheets("¥Í²£»â°h®Æ©ú²Óªí")
  10.    For Each a In .Range("A:A").SpecialCells(xlCellTypeConstants)
  11.    If d(a.Value) <> "" Then
  12.       ay = Split(d(a.Value), ",")
  13.        a.Offset(, 16).Resize(, UBound(ay) + 1) = ay
  14.     End If
  15.    Next
  16. End With
  17. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 4# Hsieh
¾Ç²ß¤F¡A³o¥N½X¦n¦h¤F¡A
ªº½TÀ³¸ÓºÉ¶q¤Ö¥Î½Æ»s¶K¤W¤ñ¸û¦n¡C

TOP

ÁÂÁ¦U¦ì¥ý¶iªºÀ°¦£!

TOP

        ÀR«ä¦Û¦b : ªY½à§O¤H´N¬O²øÄY¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD