Excel 2003 - 宏按单元格值删除多行

时间:2013-05-16 17:37:51

标签: vba row cell excel-2003

目标:我正在寻找一个可以根据一列中的单元格标准删除多行的宏,但我希望宏在每次运行时都要求一个值,而不是在代码中包含一个设置值。到目前为止,我在网上找到的每个代码都不起作用或只编码一个值。

我正在使用excel 2003

这是我发现的一个符合我目的的代码..但是我想以某种方式编辑它以便它提示用户输入一定数量,而不是一遍又一遍地使用相同的数字

      Sub Delete_Rows()
            Dim rng As Range, cell As Range, del As Range
            Set rng = Intersect(Range("A2:J707"), ActiveSheet.UsedRange)
            For Each cell In rng
            If (cell.Value) = "201" _
            Then
            If del Is Nothing Then
            Set del = cell
            Else: Set del = Union(del, cell)
            End If
            End If
            Next cell
            On Error Resume Next
            del.EntireRow.Delete
        End Sub

2 个答案:

答案 0 :(得分:0)

您应该查看InputBox function

基本上,它会在对话框中显示提示,等待用户输入文本或单击按钮,然后返回包含文本框内容的字符串。

因此,对于您的代码,它将是这样的:

 Sub Delete_Rows()
    Dim selectedValue As Integer
    selectedValue = InputBox ("Please, enter a number", "Input for deleting row", Type:=1)
                              'Prompt                   'Title                  'Value type (number here)
    Dim rng As Range, cell As Range, del As Range
    Set rng = Intersect(Range("A2:J707"), ActiveSheet.UsedRange)
    For Each cell In rng
    If (cell.Value) = selectedValue _
    Then
    If del Is Nothing Then
    Set del = cell
    Else: Set del = Union(del, cell)
    End If
    End If
    Next cell
    On Error Resume Next
    del.EntireRow.Delete
End Sub

答案 1 :(得分:0)

试试这个。它的工作原理是首先选择所需的范围,然后运行宏。实际上只有第一行和最后一行在该范围内很重要,因此范围可以只是一列宽度。它将删除所选范围内的所有行,其中输入的列中的值与输入的值相匹配。

Sub DeleteRows()
    Application.ScreenUpdating = False

    Dim msg As String, title As String
    Dim col As Integer
    Dim value As String

    msg = "Enter column number:"
    title = "Choose column"
    col = InputBox(msg, title)

    msg = "Enter string to search for:"
    title = "Choose search string"
    value = InputBox(msg, title)

    Dim rSt As Integer, rEn As Integer
    rSt = Selection.Rows(1).Row
    rEn = rSt + Selection.Rows.Count - 1

    Dim r As Integer
    r = rSt
    While r <= rEn
        If Cells(r, col).value = value Then
            Rows(r).EntireRow.Delete Shift:=xlUp
            rEn = rEn - 1
        Else
            r = r + 1
        End If
    Wend

    Application.ScreenUpdating = True
End Sub