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

【问题标题】：Excel 2003 - Macro to delete multiple rows by cell valueExcel 2003 - 按单元格值删除多行的宏
【发布时间】：2013-05-11 17:32:58
【问题描述】：

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

我正在使用 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

【问题讨论】：

您是否尝试过所提供的任一解决方案？如果其中一位回答了您的问题，您应该将其标记为答案。
是的，第二个为我的目的工作，但我是新人，显然有我的 1 名声......我在哪里将其标记为答案？

标签： vba row cell excel-2003

【解决方案1】：

你应该检查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

【讨论】：

谢谢伙计。在您提供的网站的帮助下，我不得不稍微编辑一下代码。但它完成了工作。

【解决方案2】：

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

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

【讨论】：