2013-05-16 6 views
0

Цель: я ищу макрос, который может удалять несколько строк на основе критериев ячейки в одном столбце, но я хочу, чтобы макрос запрашивал значение каждый раз, когда он запускается вместо того, чтобы иметь установленное значение, включенное в код. Каждый код, который я нашел онлайн, пока либо не работает, либо закодирован только для одного значения.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 
+0

Пробовали ли вы какие-либо из предлагаемых решений? Если один из них отвечает на ваш вопрос, вы должны отметить его как ответ. – neizan

+0

Да, вторая работала для моих целей, но я новичок, ясно с моей 1 репутацией ... где я помечен как ответ? – elpablo

+0

Ничего, я вижу. – elpablo

ответ

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

Спасибо человеку. Мне пришлось немного изменить код с помощью предоставленного вами веб-сайта. Но он выполнил свою работу. – elpablo

+0

Nice :) Рад, что он работает! –

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 
Смежные вопросы