Excel 2003 - 셀 값으로 여러 행을 삭제하는 매크로

Question

목표 : 하나의 열에서 셀 조건에 따라 여러 행을 삭제할 수있는 매크로를 찾고 있지만 실행될 때마다 매크로에 값을 요청하려고합니다 코드에 설정 값을 포함시키는 것보다 지금까지 온라인에서 찾은 각 코드는 작동하지 않거나 하나의 값으로 만 코딩됩니다.

나는 여기에 내 목적을 위해 작품을 발견 한 하나 개의 코드는 엑셀 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 

Answer 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 

Answer 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