Loop to start at a cell and delete the next 600 in the column

问题

All of my data is in the "D" column.

I want to start a specific cell (ie. D249) and then select the next 600 and delete them (ie. D250-D850). Then I want to skip the next one down (ie. D851) and delete the next 600 below that. I want to do this until it gets to the end, which is like D19000. I think I need to use a while loop to check if data is present in the cell I'm looking at.

This is the code I have so far:

Sub delete600rows()
'delete600rows Macro
'Keyboard Shortcut: Ctrl+a

ActiveSheet.Range("D249").Select
While LEN()>0

Range("D249:D848").Select
Selection.Delete Shift:=xlUp

End Sub

How do I write the condition for the while loop and how do I make the range select work the way I want it to?

回答1:

The one below should work. I have not tested it extensively. I put an option where you can select the cell you want to start from and how many rows you want to delete. If those are standard just hard code them in the code :)

Sub deleteNumOfrows()
Dim myBook As Workbook
Dim mySheet As Worksheet
Dim startCell As Range
Dim numOfRowsToDelete As Long
Dim lastRow As Long
Dim i As Long

'Set your workbook - in this version I select the active workbook
Set myBook = ActiveWorkbook

'Set up your worksheet - In this version I select the active worksheet
Set mySheet = myBook.ActiveSheet

'Select the cell you want to start
Set startCell = Application.InputBox(prompt:="Select a cell", Type:=8)

'Input how many rows you want to delete - If it is always 600 just set it to that
numOfRowsToDelete = Application.InputBox(prompt:="Number of rows to delete each time")

'Find the last row data exists in the column of the startCell
lastRow = mySheet.Cells(mySheet.Rows.Count, startCell.Column).End(xlUp).Row

'Delete the rows you do not want
i = startCell.Row 'Start from the row of the startCell

While i <= lastRow 'Repeat while you haven't reached the last row
    'mySheet.Rows((i + 1) & ":" & (i + numOfRowsToDelete)).EntireRow.Delete 'Delete the rows
    mySheet.Range(Cells((i + 1), startCell.Column), Cells((i + numOfRowsToDelete), startCell.Column)).Delete Shift:=xlUp  'Delete the range you dont want
    i = i + 1 'Next row
    lastRow = lastRow - numOfRowsToDelete 'Adjust lastRow
Wend

End Sub

回答2:

(sorry, commenting not yet possible for me.)

I'm a little confused I have to say: Why would you only want to delete 600 rows if you can just delete everything from cell D249 downwards? Is there something you are looking for in this column? What is the use of this?

Otherwise there would be a possibility to check for the last row:

Dim LastRow as Long
LastRow = ActiveWorkbook.ActiveSheet.Cells(ActiveWorkbook.ActiveSheet.Rows.Count, "D").End(xlUp).Row

And then you could just delete everything from D249 to the last filled row in your workbook.

If I am wrong, there would really be some more clarification neccessairy.

回答3:

You count use a for loop and add instance of 501, the cyntax is off, but I grew up in php

start = 249
len = 500 

for (i=0;i=100;i++) {
    from = (i*(len+1)+start
    to = from+len
    range.select("D" & from & ":D" & to
    if (range.select("D" & from).value = ""){
       break
    }
}

回答4:

try this code:

Sub test()

 Dim LR As Long
 Dim Rng As Range

 LR = Range("D" & Rows.Count).End(xlUp).Row
 Debug.Print LR
 If LR < 851 Then
  Set Rng = Range("D250:D850")
 Else
   For i = 249 To LR Step 601
    j = j + 1
    If Rng Is Nothing Then
     Set Rng = Range(Cells(i + j, "D"), Cells(i + j + 600, "D"))
    Else
     Set Rng = Union(Rng, Range(Cells(i + j, "D"), Cells(i + j + 600, "D")))
    End If
   Next
 End If

 Rng.Delete xlUp
End Sub

If you want to delete Entire Row replace Rng.Delete xlUp with Rng.EntireRow.Delete.

回答5:

This is more of an idea for you to adapt than the correct code:

Dim StartRow As Integer
StartRow = 249
Dim DelRow As Integer
DelRow = 600
Dim LastRow AS Integer
LastRow = ActiveDocument.ActiveSheet.Cells(ActiveDocument.ActiveSheet.Rows.count, "a").End(xlUp).Row

If Not (LastRow + 1) Then

'I don't know if this will work, if you can test for the end of the table
'differently, I believe this would be better (maybe even "Do Until (LastRow + 1)")

    ActiveDocument.ActiveSheet.Range("D" & (StartRow + 1):"D" & (StartRow + 1 + DelRow).Delete
    StartRow = StartRow + 1
End If

Something like this could work as you always delete 600 Rows at a time then you want to keep the next. So after you have deleted the range 250-850 the row 250 is now containing what was in row 851 before deleting it.

来源：https://stackoverflow.com/questions/34679569/loop-to-start-at-a-cell-and-delete-the-next-600-in-the-column

标签

excel

vba

excel-vba

while-loop