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

[µo°Ý] vba¯S©w®æ¦¡§R°£

¦^´_ 3# man65boy

¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 2) As Range, Sh As Worksheet
  4.     For Each Sh In Sheets  ' Sheets ª«¥ó: ¬¡­¶Ã¯Sheetªºª«¥ó¶°¦X
  5.         Set Rng(1) = Sh.Cells.Find(Sh.Range("a4"), Sh.Range("a4")) ' [ª««~½s¸¹ ]©Ò¦b¦C:¬°©Ò¦³¤u§@ªíªí³æ¤Wªº¦@³qÂI
  6.         If Not Rng(1) Is Nothing Then '¤u§@ªí¤W¦³´M§ä¨ì [ª««~½s¸¹ ]
  7.             Set Rng(2) = Nothing
  8.             Do
  9.                 If Rng(2) Is Nothing Then
  10.                     Set Rng(2) = Rng(1).Offset(-3).Resize(4).EntireRow     '[ª««~½s¸¹ ]©Ò¦b¦C ,©¹¤W4¦CÀx¦s®æªº¾ã¦C
  11.                 Else
  12.                     Set Rng(2) = Union(Rng(2), Rng(1).Offset(-3).Resize(4).EntireRow)  ''¾ã¦X:[ª««~½s¸¹ ]©Ò¦b¦C ,©¹¤W4¦CÀx¦s®æªº¾ã¦C
  13.                 End If
  14.                 Set Rng(1) = Sh.Cells.FindNext(Rng(1))
  15.             Loop Until Rng(1).Address(0, 0) = "A4"
  16.             If Not Rng(2) Is Nothing Then Rng(2).Delete   '§R°£
  17.         End If
  18.     Next
  19. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 11# c_c_lai
8#ªºµ{¦¡½X ­×§ï ·j´M§¹¥þ¤@¼Ëªº¦r¦ê
   
  1. Set Rng(1) = Sh.Cells.Find(Sh.Range("a4"), Sh.Range("a4"), LookAt:=xlWhole)
  2. ' ¥[¤W³o°Ñ¼Æ , XlLookAt ±`¼Æ¤§¤@¡GxlWhole ©Î xlPart¡C
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 14# man65boy
¸Õ¸Õ¬Ý
  1. Sub Ex()
  2.     Dim Sh As Worksheet, Rng As Range
  3.     On Error Resume Next  'µ{¦¡¦³¿ù»~¤£²z·|,Ä~Äò°õ¦æ¤U¥h
  4.     For Each Sh In Worksheets
  5.         Set Rng = Sh.UsedRange.Columns("I:I").Offset(4)  'Columns("I:I") ¤u§@ªí¸ê®Æªº³Ì«á¤@Äæ ,Offset(4) ¸ê®Æ²Ä¤­¦C¶}©l
  6.         Rng.MergeCells = False                                          '¨ú®ø¦X¨ÖªºÀx¦s®æ
  7.         Rng.Value = Rng.Value                                         'Àx¦s®æªº®æ¦¡³]¬° ¼Æ¦r
  8.         Set Rng = Union(Rng.SpecialCells(xlCellTypeBlanks), Rng.SpecialCells(xlCellTypeConstants, xlTextValues))
  9.          'xlCellTypeBlanks ªÅ¥ÕªºÀx¦s®æ, SpecialCells(xlCellTypeConstants, xlTextValues)  '¤å¦rªºÀx¦s®æ
  10.          'UsedRange.Columns("I:I").Offset(4) Àx¦s®æ¤¤ ¨S¦³ [ªÅ¥Õªº],[¤å¦rªº] µ{¦¡·|¿ù»~
  11.         If Err = 0 Then Rng.EntireRow.Delete
  12.         If Err > 0 Then Err.Clear
  13.     Next
  14. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¥ÌÄ@°µ¡BÅw³ß¨ü¡C
ªð¦^¦Cªí ¤W¤@¥DÃD