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

½Ð°ÝSHEETÂà´«¬ö¿ýªº°ÝÃD

½Ð°ÝSHEETÂà´«¬ö¿ýªº°ÝÃD

1.½Ð°Ý¤@¤U,¦p¦ó±NA SHEET¦s¨ìB SHEET·íJÄ榳¥X²{¥ô¦ó­È®É¹ïÀ³ªº¸Ó¦C´N·|½Æ»s¨ìB SHEET(ªÅ¥Õ³B©µ¦ù)¤¤


2.¥t¤@ºØ¬O·í«ö¤U«ö¶s®É(¹ïÀ³¤u³æ¸¹½X),«h¸Ó¤u³æ¹ïÀ³ªº©Ò¦³¦C´N½Æ»s¨ìB SHEETªÅ¥Õ³B

B SHEET­n¤@ª½²Ö¥[,¤£¯à¯dªÅ¥Õ
ÁÂÁÂ

Book1111.rar (38.99 KB)

Tony

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-2-14 17:46 ½s¿è

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

TOP

¥»©«³Ì«á¥Ñ tonycho33 ©ó 2012-2-14 18:46 ½s¿è

¦^´_ 2# GBKEE


    ½Ð°Ý¡y1.½Ð°Ý¤@¤U,¦p¦ó±NA SHEET¦s¨ìB SHEET·íJÄ榳¥X²{¥ô¦ó­È®É¹ïÀ³ªº¸Ó¦C´N·|½Æ»s¨ìB SHEET(ªÅ¥Õ³B©µ¦ù)¤¤¡z
¦³­Ó°ÝÃD²Ä¤@¦¸¿é¤JJÄæ®É¬Y¤@®æÀx¦s®æ¥i¥H¬ö¿ý
               ²Ä¤G¦¸¦A¿é¤J®É¡A¦]¬°­ì¥»²Ä¤@¦¸ÁÙ¦b¡A©Ò¥H·|¦b­«½Æ°O¿ý¨ì
¥i¥H§PÂ_¦³­«½Æªº¸Ü´N¤£·|¬ö¿ý¶Ü
¥t¥~½Ð°Ý
Data_Copy 10, xText

Data_Copy 1, xText
¬°¤°»ò¬O1©M10®t¦b­þ

ÁÂÁÂ
Tony

TOP

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

TOP

¥»©«³Ì«á¥Ñ tonycho33 ©ó 2012-2-15 10:36 ½s¿è

¦^´_ 4# GBKEE

¯u¤£¦n·N«ä
«D±`·PÁ§Aªº«ü¾É
½Ð°Ý¡y ¦³¿z¿ï­«½Æªº­n§R±¼¡z­n¦p¦ó­×§ï
ÅýB sheet ¥X²{³æ¤@ªº¹ïÀ³Äæ¦ì´N¦n
  1. Sub §R°£­«½Æ1()
  2. Dim i As Long
  3. Application.ScreenUpdating = False
  4. For i = Range("a65536").End(xlUp).Row To 3 Step -1
  5.   If WorksheetFunction.CountIf(Range("a2:a" & i), Cells(i, 1)) > 1 Then
  6.     Cells(i, 1).EntireRow.Delete
  7.   End If
  8. Next
  9. Application.ScreenUpdating = True
  10. End Sub
½Æ»s¥N½X
³o­Ó¬O¤ñ¹ïAÄæ­«½Æªº
¦pªG§Ú·Q§ï¤ñ¹ïAÄæ¡®CÄæ­«½Æªº­n¦p¦ó­×§ï©O
ÁÂÁÂ
Tony

TOP

¦^´_ 5# tonycho33

¶Wª©,ª©¥D¤j·§¬O¨S¦³§@¤£¥X¨Óªº°ÝÃD
­«ÂI¬O§Æ±æµo°ÝªÌ:
1.¨Æ¥ý§@¦n¥\½Ò,§â§Æ±æªº¥\¯à´y­z²M·¡,¤£­n¤Ï¤ÏÂÐÂÐ,§ï¨Ó§ï¥h(´X¦¸«á¯uªº¨S¤H·QÀ°)
2.ªþ¤WEXCELÀÉ®×,¼Æ¾ÚÀ³§â©Ò¦³¥i¯àªº±¡§Î³£¦Ò¼{¶i¨Ó


SHEET B¤§KÄ椣¥i¦³¸ê®Æ
¦P¤@¤u³æ­Y¦³ªº§¹¦¨,¦³ªº¥¼§¹¦¨¦³®É·|¤À¶}Åã¥Ü(À³¥i±µ¨ü§a)
  1. Sub Ex()                       '1.±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.«ö¤U«ö¶s®É(¹ïÀ³¤u³æ¸¹½X),¸Ó¤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.     Call deleterow                       '§R°£B¤u§@ªí¤§­«ÂЦC
  27.     Application.ScreenUpdating = True
  28.     Application.DisplayAlerts = True
  29. End Sub
  30. Sub deleterow()                          '§R°£B¤u§@ªí¤§­«ÂЦC
  31.     With Sheet6
  32.       R = .[A65536].End(xlUp).Row
  33.       For RM = 2 To R
  34.         For MM = 1 To 9                  'SHEET B¤§KÄ椣¥i¦³¸ê®Æ
  35.             .Cells(RM, 11) = .Cells(RM, 11) & .Cells(RM, MM)
  36.         Next MM
  37.       Next RM
  38.       For I = 2 To R Step 1
  39.         If (WorksheetFunction.CountIf(.Columns(11), .Cells(I, 11)) > 1) Then
  40.            .Rows(I).Delete
  41.            I = I - 1
  42.         End If
  43.       Next
  44.       .Columns(11) = ""
  45.     End With
  46. End Sub
½Æ»s¥N½X
Book1111.rar (48.49 KB)

TOP

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

TOP

¦^´_ 7# GBKEE

¤£¦n·N«ä¥i¥H¦b½Ð±Ð¤@­ÓÃþ¦üªº°ÝÃD¶Ü
§Ú·Q±Naa sheet°O¿ý¨ìbb sheet
±ø¥ó¬O¦baa sheet¹ïÀ³ªºt Ä榳¥X²{­Èªº¸Ü
´N±N¹ïÀ³ªºA¨ìRÄ橹¤U3¦C½Æ»s¨ìbb sheet
¦ý¬O¸ê®ÆÁÙ­n«O¯d/¤£­n§R°£

¨Ò¦p¡G·íT3¥X²{"¤w±Æµ{"®É«hA3¨ìR5 ¤T¦Ccopy¨ìbb sheet¤¤ ªÅ®æ³B
¦ý¬OA3¨ìR5¤£­n§R°£
±µ¤U¨Ó´N¥H¦¹Ãþ±À¥i¥H¥é·Ó³o¼Ë°O¿ý

ÁÂÁÂ

Book1.rar (21.19 KB)

Tony

TOP

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

TOP

¦^´_ 9# GBKEE


    ³Â·ÐÁÂÁÂ

Book1.rar (21.29 KB)

Tony

TOP

        ÀR«ä¦Û¦b : ¥@¤W¦³¨â¥ó¨Æ¤£¯àµ¥¡G¤@¡B§µ¶¶ ¤G¡B¦æµ½¡C
ªð¦^¦Cªí ¤W¤@¥DÃD