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

¸ê®ÆÂà¼g

¸ê®ÆÂà¼g

¦p¦ó¥H¿ï¾Ü¯S©w¸ê®Æ¡A«ö¶s¦bÂà¼g¡A³Â·Ð¦U¦ì¦Ñ®v­Ì¤£¥t«ü±Ð!
ªþÀÉ:

¸ê®ÆÂà¼g.rar (2.42 KB)

¦^´_ 1# man65boy
  1. Option Explicit
  2. Sub Ex()
  3.     Dim A As Range, R As Range, Rng As Range
  4.     With Sheet1
  5.         .AutoFilterMode = False                         ' ¨ú®ø[¦Û°Ê¿z¿ï]
  6.         .Range("a1").AutoFilter 5, "¦Û¨ú"               '[¦Û°Ê¿z¿ï] ³]©w²Ä5Ä檺¿z¿ï·Ç«h = "¦Û¨ú"
  7.         With .UsedRange.SpecialCells(xlCellTypeVisible) '¦Û°Ê¿z¿ï«áªº¸ê®Æ
  8.             .Copy Sheet2.[A1]                           '½Æ»s¸ê®Æ
  9.             For Each A In .Areas                        'Areas ÄÝ©Ê: ¦¹¶°¦X¥Nªí¦h­«½d³ò¤¤ªº©Ò¦³½d³ò¡C°ßŪ
  10.                 For Each R In .Rows                     '½d³ò ªº¾ã¦C
  11.                     If R.Row <> 1 Then                  '¦C¸¹¤£¬OÄæ¦ìªº ¦C¸¹
  12.                         If Rng Is Nothing Then
  13.                             Set Rng = R
  14.                         Else
  15.                             Set Rng = Union(Rng, R)     'Union ¤èªk  ©w¶Ç¦^¨â­Ó©Î¦h­Ó½d³òªº¦X¨Ö½d³ò
  16.                         End If
  17.                     End If
  18.                 Next
  19.             Next
  20.         End With
  21.         .AutoFilterMode = False                         ' ¨ú®ø[¦Û°Ê¿z¿ï]
  22.         If Not Rng Is Nothing Then                  '¦Û°Ê¿z¿ï ¦³¸ê®Æ
  23.             Application.DisplayAlerts = False       'DisplayAlerts ÄÝ©Ê  Microsoft Excel Åã¥Ü¯S©wªºÄµ§i©M°T®§«h¬° True¡CŪ/¼g Boolean¡C
  24.             Rng.Delete                              '§R°£ ¦Û°Ê¿z¿ï«áªº¸ê®Æ
  25.             Application.DisplayAlerts = True
  26.         Else                                        '¦Û°Ê¿z¿ï ¨S¦³¸ê®Æ
  27.             MsgBox "¬d¯Q¸ê®Æ"
  28.         End If
  29.     End With
  30. End Sub
½Æ»s¥N½X

TOP

¦^´_ 1# man65boy
  1. Sub xx()
  2. Dim Rng As Range, A As Range
  3. Sheet1.[A1:E1].Copy Sheet2.[A1]
  4. With Sheet1
  5.   For Each A In .Range(.[A2], .[A2].End(xlDown))
  6.     If A.Offset(0, 4) = "¦Û¨ú" Then
  7.       If Rng Is Nothing Then
  8.          Set Rng = A.Resize(1, 5)
  9.       Else
  10.          Set Rng = Union(Rng, A.Resize(1, 5))
  11.       End If
  12.     End If
  13.   Next
  14.   If Not Rng Is Nothing Then
  15.      Rng.Copy Sheet2.[A65536].End(xlUp).Offset(1, 0)
  16.      Rng.EntireRow.Delete
  17.   End If
  18. End With
  19. End Sub
½Æ»s¥N½X

TOP

¦^´_ 3# register313


    ·PÁÂ2¦ì¼ö¤ßª©¥Dªº¦^µª¡AGBKEE¦Ñ®vªºµ{¦¡´£¨Ñ¤F¡A§Ú³oºØªì¾ÇªÌ©öÀ´ªºµ{¦¡¡A¦ýµ{¦¡°õ¦æÂà¼g¨ìsheet2®É¡A¨ÃµLªk©¹¤U±Æ¦C¡AµyÂI¤£¨¬¡A¤£¹LÁÙÁÂÁÂGBKEE¦Ñ®v¡A
    ·PÁÂregister313¦Ñ®v¡A´£¨Ñ§¹¥þ¸ÑÃD¦Ê¤À¦Ê¡A·P®¦¦b¤ß!¤p§Ì¤]­nªáÂI®É¶¡¨Ó®ø¤Æ2¦ì¦Ñ®vªºµ{¦¡¡AÁÂÁ¡C

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-4-29 15:52 ½s¿è

¦^´_ 4# man65boy
¨ÃµLªk©¹¤U±Æ¦C¡AµyÂI¤£¨¬   ­×¥¿¤F
  1. Option Explicit
  2. Sub Ex()
  3.     Dim A As Range, R As Range, Rng As Range
  4.     With Sheet1
  5.         .AutoFilterMode = False                         ' ¨ú®ø[¦Û°Ê¿z¿ï]
  6.        .Range("a1").AutoFilter 5, "¦Û¨ú"               '[¦Û°Ê¿z¿ï] ³]©w²Ä5Ä檺¿z¿ï·Ç«h = "¦Û¨ú"
  7.         Sheet2.Rows(1) = .Rows(1).Value
  8.         Set Rng = .Range("a1").CurrentRegion.Offset(1)
  9.         On Error Resume Next
  10.         Set Rng = Rng.SpecialCells(xlCellTypeVisible)        '¦Û°Ê¿z¿ï«áªº¸ê®Æ
  11.          If Err.Number > 0 Then                              '¨S¦³¸ê®Æ¦³¿ù»~
  12.             MsgBox "¬dµL¸ê®Æ"
  13.          Else
  14.             Rng.Copy Sheet2.Cells(Rows.Count, "a").End(xlUp).Offset(1)             '§ï¦b³o¸Ì½Æ»s
  15.             Rng.Delete xlShiftUp                              '§R°£ ¦Û°Ê¿z¿ï«áªº¸ê®Æ
  16.           End If
  17.         .AutoFilterMode = False                         ' ¨ú®ø[¦Û°Ê¿z¿ï]
  18.     End With
  19. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¨Ã«D¦³¿ú¾{¬O§Ö¼Ö¡A°Ý¤ßµL·\¤ß³Ì¦w¡C
ªð¦^¦Cªí ¤W¤@¥DÃD