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

hugh0620

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)

¤U¸ü¦¸¼Æ: 9

2012-7-5 16:26

               
                ´£¨Ñ¦Û¦æ§¹¦¨ªºÀÉ®×
                ¨Ì±ø¥ó¥t¦s·sÀÉ-¤w§¹¦¨.rar (11.33 KB)

¤U¸ü¦¸¼Æ: 11

2012-7-6 14:51

hugh0620

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

½Æ»s¥N½X

Hsieh

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

avel

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