GBKEE

¦^´_ 1# tonycho33
***[D1:F1] ¤£¥i¬°ªÅ¥Õ***

1. Sub Ex()'1.½Ð°Ý¤@¤U,¦p¦ó±NA SHEET¦s¨ìB SHEET·íJÄ榳¥X²{¥ô¦ó­È
   
2.     Dim xText As String
   
3.     xText = "<>" '
   
4.    Data_Copy 10, xText
   
5. End Sub
   
6. Sub ExA() '2.¥t¤@ºØ¬O·í«ö¤U«ö¶s®É(¹ïÀ³¤u³æ¸¹½X),«h¸Ó¤u³æ¹ïÀ³ªº©Ò¦³¦C´N½Æ»s¨ìB SHEETªÅ¥Õ³B
   
7.     Dim xText As String
   
8.     xText = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
   
9.     Data_Copy 1, xText
   
10. End Sub
    
11. Private Sub Data_Copy(xF As Integer, xCriteria As String)
    
12.     Dim Sh As Worksheet
    
13.     Application.ScreenUpdating = False
    
14.     Application.DisplayAlerts = False
    
15.      With Sheet7   'Sheets("A")
    
16.         .AutoFilterMode = False
    
17.         .Range("a1").AutoFilter Field:=xF, Criteria1:=xCriteria
    
18.         Set Sh = Sheets.Add
    
19.         .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.[a1]
    
20.         Sh.UsedRange.Offset(1).Copy Sheet6.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    
21.       'Sheet6->Sheet("B")
    
22.         Sh.Delete
    
23.         .AutoFilterMode = False
    
24.         .Activate
    
25.     End With
    
26.     Application.ScreenUpdating = True
    
27.     Application.DisplayAlerts = True
    
28. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 3# tonycho33
"²Ä¤G¦¸¦A¿é¤J®É¡A¦]¬°­ì¥»²Ä¤@¦¸ÁÙ¦b¡A©Ò¥H·|¦b­«½Æ°O¿ý¨ì"
§A¤S¨S»¡ ¦³¿z¿ï¹Lªº­n§R±¼ !!!
.Range("a1").AutoFilter Field:=xF, Criteria1:=xCriteria
Range("a1").AutoFilter:    ¦b A1¾î¦VªºÄæ¦ì [A1:J1] ¦Û°Ê¿z¿ï  
Field:=1   :¿z¿ïªºÄæ¦ì ->AÄæ ; Field:=10   :¿z¿ïªºÄæ¦ì ->J Äæ

GBKEE

¦^´_ 5# tonycho33

1. Private Sub Data_Copy(xF As Integer, xCriteria As String)
   
2.     Dim Sh As Worksheet, Rng(1 To 2) As Range, xRow As Range
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.      With Sheet7   'Sheets("A")
   
6.         .AutoFilterMode = False
   
7.         .Range("a1").AutoFilter Field:=xF, Criteria1:=xCriteria
   
8.         Set Rng(1) = .UsedRange.SpecialCells(xlCellTypeVisible)
   
9.         If Application.CountA(Rng(1)) = Rng(1).Columns.Count Then  
   
10.              .AutoFilterMode = False
    
11.             MsgBox IIf(xCriteria <> "<>", "§ä¤£¨ì ¤u³æ :" & xCriteria, "§¹¦¨®É¶¡  ¨S¦³ªº¸ê®Æ")
    
12.             GoTo e
    
13.         End If
    
14.         Set Sh = Sheets.Add
    
15.         Rng(1).Copy Sh.[a1]
    
16.         Sh.UsedRange.Offset(1).Copy Sheet6.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    
17.         Sh.Delete
    
18.         .AutoFilterMode = False
    
19.         .Activate
    
20.         For Each xRow In Rng(1).Rows.Cells
    
21.             If xRow.Row <> 1 Then
    
22.                 If Rng(2) Is Nothing Then
    
23.                     Set Rng(2) = xRow
    
24.                 Else
    
25.                     Set Rng(2) = Union(xRow, Rng(2))
    
26.                 End If
    
27.             End If
    
28.         Next
    
29.         Rng(2).Delete xlShiftUp
    
30.     End With
    
31. e:
    
32.     Application.ScreenUpdating = True
    
33.     Application.DisplayAlerts = True
    
34. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 8# tonycho33
    ·íT3¥X²{"¤w±Æµ{"®É«h
SHEETS("AA") TÄ椤³£¨S¦³¸ê®Æ°Ú

GBKEE

¦^´_ 10# tonycho33
½Ð°Ý ¦p¹Ï

¤U¸ü (32.19 KB)

2012-2-16 12:58