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

[µo°Ý] (¦Û¦æ¸Ñ¨M~ ¤j¤jÁÙ¬O¥i¥H«ü¾É~ ´£¨Ñ¼gªk)¨Ì±ø¥ó±Nsheet¥t¦s·sÀÉ

[µo°Ý] (¦Û¦æ¸Ñ¨M~ ¤j¤jÁÙ¬O¥i¥H«ü¾É~ ´£¨Ñ¼gªk)¨Ì±ø¥ó±Nsheet¥t¦s·sÀÉ

¥»©«³Ì«á¥Ñ hugh0620 ©ó 2012-7-6 14:51 ½s¿è

Dear ¤j¤j­Ì
               ¤p§Ì¥d¨ì¤@­Ó°ÝÃD~ ¦pªþ¥ó
                ¦@¦³5­Ósheet  (­ì©l¸ê®Æ¤£¤î5­Ósheet)
                1. Data
                2. 1,2,3,4 ¬°­n¥t¦sªºsheet

                °ÝÃD¦p¤U:
                1. ¨Ìdataªº±ø¥ó
                         a¦³:1,2
                         b¦³:1,2,3,4
                 2. ¥u­na²Å¦X1,´N¬O1&2 ªºsheet,¥t¦s1­ÓÀÉ®×
                              b²Å¦X2,´N¬O3&4 ªºsheet,¥t¦s1­ÓÀÉ®×
                ½Ð¤j¤j­Ì¾É¤@¤U~
                ¨Ì±ø¥ó¥t¦s·sÀÉ.rar (4.43 KB)
               
                ´£¨Ñ¦Û¦æ§¹¦¨ªºÀÉ®×
                ¨Ì±ø¥ó¥t¦s·sÀÉ-¤w§¹¦¨.rar (11.33 KB)
¾Ç²ß¤~¯à´£¤É¦Û¤v

¥H¤U¬O°w¹ï§Úµo¤åªº°ÝÃD~ ¦Û¦æ«÷´ê¥X¨Óªº¸Ñ¨M¤è¦¡~

¥D­n¬O¦b¤@¶}©l¼gªº®É­Ô~ ·í§Ú·s¼W¤@­Óworkbooks®É~
¦b¶]For each Sh in [    ]®É~ ¦Ñ¬O¥h¼´¨ú·s¼Wªº workbooks~ ´N¥d¦b¨ºÃä
¦]¬°ª¾¹D¬O­þÃä¥X¤F°ÝÃD~ ¦ý¹ï©óworkbooks /sheets / ThisWorkbook.Worksheets ...³o¨Çªº¥Îªk¤£¬O«Ü¼ô±x~
©Ò¥H~ ¤@ª½´ú¸Õ~ ²×©ó§ä¨ì¾A¦Xªº«ü¥O~

­Y¤j¤j¦³³o¤è­±ªº¸ê°T~ ©Î¬O¦³¨ä¥L§ó¦nªº¼gªk~ ¥ç¤£§[«ü¾É¤@¤U~
  1. Sub ex()
  2. Application.DisplayAlerts = False
  3. Dim Sh As Worksheet
  4. '====¶i¶¥¿z¿ï=====
  5.     Range("B4:B8").Select
  6.     Range("B4:B8").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E4" _
  7.         ), Unique:=True
  8. '=================

  9. A = Sheet1.Range("E65536").End(xlUp).Row

  10. For I = 5 To A
  11.     H = Sheet1.Range("E" & I)
  12.     Workbooks.Add
  13.     k = ActiveWorkbook.Name
  14.         For J = 5 To 8
  15.             For Each Sh In ThisWorkbook.Worksheets
  16.                 If Sh.Name = Sheet1.Range("C" & J) And H = Sheet1.Range("B" & J) Then
  17.                    With ThisWorkbook.Worksheets(Sh.Name)
  18.                         .Copy Before:=Workbooks(k).Sheets(1)
  19.                    End With
  20.                 End If
  21.             Next
  22.         Next
  23.                 With ActiveWorkbook
  24.                      If Sheets.Count > 1 Then
  25.                          .Sheets("Sheet1").Delete
  26.                          .SaveAs "C:\Documents and Settings\Hugh.Huang\®à­±\·s¸ê®Æ§¨\" & H
  27.                          .Close
  28.                      Else
  29.                          .Sheets("Sheet1").Name = "µL"
  30.                          .SaveAs "C:\Documents and Settings\Hugh.Huang\®à­±\·s¸ê®Æ§¨\" & H
  31.                          .Close
  32.                      End If
  33.                 End With

  34. Next
  35. Application.DisplayAlerts = True
  36. End Sub
½Æ»s¥N½X
¾Ç²ß¤~¯à´£¤É¦Û¤v

TOP

¦^´_ 2# hugh0620

¤u§@ªí¸s²Õ½Æ»s
  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With Sheet1
  4. For Each A In .Range(.[B5], .[B5].End(xlDown))
  5.   d(A.Value) = IIf(d(A.Value) = "", A.Offset(, 1), d(A.Value) & "," & A.Offset(, 1))
  6. Next
  7. For Each ky In d.keys
  8.   Sheets(Split(d(ky), ",")).Copy
  9.   With ActiveWorkbook
  10.      .SaveAs "D:\" & ky & ".xls"
  11.      .Close 1
  12.   End With
  13. Next
  14. End With
  15. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

学习¤F¦r¨å¤À组选择¤u§@ªí¤èªk¡C

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¨S¦³©Ò¦³Åv¡A¥u¦³¥Í©Rªº¨Ï¥ÎÅv¡C
ªð¦^¦Cªí ¤W¤@¥DÃD