2013-05-16 88 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

不錯:)很高興它的作品! –

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 
相關問題