VBA 遍历行，select 几行然后删除它们

Question

我有一个数据集，我想删除其中的每 x 行（x = 用户输入）。如果我立即删除行，最终结果将不正确，因为行顺序会随着每次删除而改变。到目前为止我写了这段代码：

Sub Delete_Data()
    'Take userinput
    Dim userInput As Variant
    Dim i As Long
    Do While True
        userInput = InputBox("please enter a number between 2-100", _
        "Lets delete some data XD")
        If IsNumeric(userInput) And userInput >= 2 _
        And userInput <= 100 Then
            Exit Do
        End If
        If MsgBox("Invalid Input, please redo or cancel", _
        vbOKCancel, "Invalid input") = vbCancel Then Exit Do
    Loop
    
    'Delete Rows
    Worksheets("Sheet1").Activate
    For i = 2 To Rows.count Step userInput
        If Rows.Cells(i, 1).Value = "" Then
            Rows(ActiveCell.Row).EntireRow.Delete
            MsgBox "you have successfully deleted every " _
            & userInput & "th row!"
            Exit For
        Else
            Rows(i).EntireRow.Select
        End If
    Next i
     
End Sub

问题在于，一旦选择了新行，先前选择的行就会消失。希望大家帮帮我。

Answer 1

使用联合，您的代码将如下所示：

Sub Delete_Data()
    'Take userinput
    Dim userInput As Variant
    Dim i As Long
    Do While True
        userInput = InputBox("please enter a number between 2-100", _
        "Lets delete some data XD")
        If IsNumeric(userInput) And userInput >= 2 _
        And userInput <= 100 Then
            Exit Do
        End If
        If MsgBox("Invalid Input, please redo or cancel", _
        vbOKCancel, "Invalid input") = vbCancel Then Exit Do
    Loop
    
    'Delete Rows
    With Worksheets("Sheet1")
        Dim delrng As Range
        For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row Step userInput 'Change 2 to whatever column has the most data
            If .Cells(i, 1).Value = "" Then
                If delrng Is Nothing Then
                    Set delrng = .Cells(i, 1).EntireRow
                Else
                    Set delrng = Union(delrng, .Cells(i, 1).EntireRow)
                End If
            End If
        Next i
    End With
        delrng.Delete
        Select Case True
            Case Right(userInput, 1) = 1 And Not userInput = 11
                MsgBox "you have successfully deleted every " _
                    & userInput & "st row!"
            Case Right(userInput, 1) = 2 And Not userInput = 12
                MsgBox "you have successfully deleted every " _
                    & userInput & "nd row!"
            
            Case Right(userInput, 1) = 3 And Not userInput = 13
                MsgBox "you have successfully deleted every " _
                    & userInput & "rd row!"
            Case Else
                MsgBox "you have successfully deleted every " _
                    & userInput & "th row!"
        End Select
End Sub

我扩展了你的 Msgbox 以根据数字正确连接。

Answer 2

感谢您的意见：

这就是最终代码

Option Explicit

Sub Delete_Data()
    'Take userinput
    Dim userInput As Variant
    Dim i As Long
    Do While True
        userInput = InputBox("please enter a number between 2-100", _
        "Lets delete some data XD")
        If IsNumeric(userInput) And userInput >= 2 _
        And userInput <= 100 Then
            Exit Do
        End If
        If MsgBox("Invalid Input, please redo or cancel", _
        vbOKCancel, "Invalid input") = vbCancel Then Exit Sub
    Loop
    
    'Activate rows "to be deleted"
    With Worksheets("Sheet1")
        Dim delRange As Range
        For i = 2 To .Cells(.Rows.count, 2).End(xlUp).Row Step userInput
            If .Cells(i, 1).Value = "" Then
                Exit For
            ElseIf delRange Is Nothing Then
                Set delRange = .Cells(i, 1).EntireRow
            Else
                Set delRange = Union(delRange, .Cells(i, 1).EntireRow)
            End If
        Next i
    End With
    
    'Mark rows "to be deleted"
    delRange.Interior.ColorIndex = 6
    
    'Ask for deltetion cofirmation
    Dim answer As Variant
    answer = MsgBox("Do you really want to delete the selected rows?", _
    vbQuestion + vbYesNo + vbDefaultButton2, "Confirm deletion")
    If answer = vbYes Then
        delRange.Delete
    Else
        delRange.Interior.ColorIndex = xlNone
        Exit Sub
    End If
    
    'Give feedback to user & look for correct english wording
    Select Case True
            Case Right(userInput, 1) = 1 And Not userInput = 11
                MsgBox "you have successfully deleted every " _
                    & userInput & "st row!"
            Case Right(userInput, 1) = 2 And Not userInput = 12
                MsgBox "you have successfully deleted every " _
                    & userInput & "nd row!"
            
            Case Right(userInput, 1) = 3 And Not userInput = 13
                MsgBox "you have successfully deleted every " _
                    & userInput & "rd row!"
            Case Else
                MsgBox "you have successfully deleted every " _
                    & userInput & "th row!"
        End Select
End Sub

VBA 遍历行，select 几行然后删除它们

VBA loop through rows, select a couple of them & then delete them

vba

for-loop