我试图编写一个代码，用于删除或保留最终用户输入的特定字的行。
我创建了两个按钮操作：
Sub Button1_Click()
Dim cell As Range
word1 = InputBox("Enter a word by which you want to keep rows", "Enter")
For Each cell In Selection
cell.EntireRow.Hidden = (InStr(1, cell, word1, 1) = 0) 'keep by a word input by the user
Next
End Sub
Sub Button2_Click()
Dim cell As Range
word2 = InputBox("Enter a word by which you want to delete rows", "Enter")
For Each cell In Selection
cell.EntireRow.Hidden = (InStr(1, cell, word2, 1) = 1) 'delete by a word input by the user
Next
End Sub
然而，这些按钮并不像我希望的那样完成。
问题：
1）我必须专门选择要搜索的文本列中的单元格;如果我选择整个数据块，一切都将被删除。
2）实际上，如果程序从J22单元格开始（向右和向下）直到达到数据结束，而不需要选择任何东西，那么程序将更加灵活。这样做的最佳方式是什么？
3）如果我按顺序多次使用这些按钮，我已经删除的行会再次弹出。如何删除＆＃34;永久＆＃34;每次我使用其中一个按钮？通过将Hidden更改为Delete，我开始遇到运行时错误。
答案 0 :(得分：2)
当您尝试永久删除宏时，宏会删除一行，将所有其他行向上移动一个以适应，这会中断“For Each ... Next”的流程。
这种方法有两种方式可以改变代码的形状 其中之一是在循环期间将要删除的行添加到联合，然后删除循环外的联合（下面的示例A）。在任何情况下，听起来你想要指定你希望这个代码工作的范围，所以我已经将它合并到每个例子中。
示例A
Sub Button1_Click()
Dim endR As Integer, endC As Integer 'depending on size of sheet may need to change to Long
Dim cell As Range, rng As Range, U As Range
Dim ws As Worksheet
Set ws = Sheets(2) ' change accordingly
endR = ws.UsedRange.Rows.Count
endC = ws.UsedRange.Columns.Count
Set rng = Range(ws.Cells(22, 10), ws.Cells(endR, endC)) ' from cell J22 to last used row of the last used column on the right
word1 = InputBox("Enter a word by which you want to keep rows", "Enter")
For Each cell In rng
If InStr(1, cell, word1, 1) = 0 Then
If U Is Nothing Then ' for the first time the code finds a match
Set U = cell.EntireRow ' add row to be deleted to U variable
Else
Set U = Union(U, cell.EntireRow) ' for any subsequent matches, add row to be deleted to Union
End If
End If
Next
U.Delete
End Sub
另一种方法是在代码开头定义你想要使用的确切范围，然后使用循环控制变量而不是每个循环向后循环该范围，当你删除一行时升档不会影响循环。
Sub Button2_Click()
Dim r As Integer, c As Integer
Dim endR As Integer, endC As Integer
Dim cell As Range, rng As Range
Dim ws As Worksheet
Set ws = Sheets(2) ' change accordingly
endC = ws.UsedRange.Columns.Count
word2 = InputBox("Enter a word by which you want to delete rows", "Enter")
For c = 10 To endC ' start from J and move to the right
endR = ws.UsedRange.Rows.Count ' after each column has been dealt with, re-evaluate the total rows in the worksheet
For r = endR To 22 Step -1 ' start from the last row and work up
If InStr(1, ws.Cells(r, c), word2, 1) = 1 Then
ws.Cells(r, c).EntireRow.Delete
End If
Next r
Next c
End Sub
答案 1 :(得分：1)
这应该可以解决问题
Option Explicit
Sub DeletingRowContainingSpecificText()
Dim DataWorkSheet As Worksheet
'Change "ThisWorkBook" an "Sheet1" as you require
Set DataWorkSheet = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
Dim LastColumn As Long
With DataWorkSheet.UsedRange
LastRow = .Rows(.Rows.Count).Row
LastColumn = Columns(.Columns.Count).Column
End With
Dim word1 As String
word1 = InputBox("Enter a word by which you want to keep rows", "Enter")
Dim RowRange As Range
Dim RowReference As Long
Dim RowContent As String
Dim WordFound As Variant
'When ever you are deleting you need to start at the end and work your way back
'Otherwise the row after the row you deleted becomes the current row
For RowReference = LastRow To 22 Step -1
'Setting the Row Range from Column J to the end for a specific row
Set RowRange = ThisWorkbook.Worksheets("Sheet1").Range(Cells(RowReference, "J"), Cells(RowReference, LastColumn))
Set WordFound = RowRange.Find(What:=word1, LookIn:=xlValues)
If Not WordFound Is Nothing Then
'Choose if you want to delete or hidden
RowRange.EntireRow.Hidden = True
RowRange.EntireRow.Delete
End If
Next RowReference
End Sub
只需将Sub内容粘贴到Button1_Click Sub即可。否则将其粘贴到您的WorkBook模块中，然后测试它是否正常工作。
我测试了它，它对我有用。
NB 在使用删除Rows或Columns时始终从列表末尾开始并按照您的方式开始工作，这样参考文献就没有了。搞砸了。
答案 2 :(得分：1)
Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.count, 10).End(xlUp).Row这将返回第10列（J）中最后一个单元格的rownumber，下面的代码中有更多示例For i = 1 To 100你检查单元格A1到A100，如果你在那个循环中删除了一行，循环仍然会继续到100而不是结束于99，循环结束在循环开始之前设置，在循环期间不变。有关该问题及其解决方案的更多信息here。一般
.Select/.Activate方法和.Selection属性，它是许多错误的来源。Option Explicit强制执行此操作。以下是带注释的重构代码。
Option Explicit
Sub Button1_Click()
'Keep rows based on input
'Declaration of variables
Dim i As Long
Dim strFilterWord As String
Dim rngCell As Range
Dim rngToDelete As Range, rngRow As Range
Dim arrRow() As Variant, arrTmp() As Variant
'Setting the filter word
strFilterWord = InputBox("Enter a word by which you want to keep rows", "Enter")
With ThisWorkbook.Worksheets("Sheet1") 'Replace "Sheet1" with the actual name of your sheet.
'Setting up for loop, currently range to loop over is J22:J(lastrow with data)
For Each rngCell In .Range(.Cells(22, 10), .Cells(Rows.Count, 10).End(xlUp))
'All values of the current row are combined into an array
'Determining and setting the range of the current row
Set rngRow = rngCell.Resize(1, 3)
'Populate a tmp array with the row range values
arrTmp = rngRow
'To use the array, it needs to be 1D, currently it is 2D, section below accomplishes this
'resize the final array
ReDim arrRow(LBound(arrTmp, 2) To UBound(arrTmp, 2))
'Copy values to final array
For i = LBound(arrTmp, 2) To UBound(arrTmp, 2)
arrRow(i) = arrTmp(1, i)
Next i
'the final array is combined to a single string value with " "(spaces) between each array element
'if the filterword is not found in the string Instr returns a 0
'If the filterword is found in the string InStr returns a number corresponding to the start position.
If InStr(1, Join(arrRow, " "), strFilterWord, vbTextCompare) = 0 Then
'Test to see if the range to delete is empty or not
If rngToDelete Is Nothing Then
'If the range is empty, it is set to the first row to delete.
Set rngToDelete = rngCell.EntireRow
Else
'if the range is not empty, the row to delete is added to the range.
Set rngToDelete = Union(rngToDelete, rngCell.EntireRow)
End If
End If
Next rngCell
'After all cells are looped over, the rows to delete are deleted in one go
If Not rngToDelete Is Nothing Then rngToDelete.Delete
End With
End Sub
Sub Button2_Click()
'Keep rows based on input
'Declaration of variables
Dim i As Long
Dim strFilterWord As String
Dim rngCell As Range
Dim rngToDelete As Range, rngRow As Range
Dim arrRow() As Variant, arrTmp() As Variant
'Setting the filter word
strFilterWord = InputBox("Enter a word by which you want to delete rows", "Enter")
With ThisWorkbook.Worksheets("Sheet1") 'Replace "Sheet1" with the actual name of your sheet.
'Setting up for loop, currently range to loop over is J22:J(lastrow with data)
For Each rngCell In .Range(.Cells(22, 10), .Cells(Rows.Count, 10).End(xlUp))
'All values of the current row are combined into an array
'Determining and setting the range of the current row
Set rngRow = rngCell.Resize(1, 3)
'Populate a tmp array with the row range values
arrTmp = rngRow
'To use the array, it needs to be 1D, currently it is 2D, section below accomplishes this
'resize the final array
ReDim arrRow(LBound(arrTmp, 2) To UBound(arrTmp, 2))
'Copy values to final array
For i = LBound(arrTmp, 2) To UBound(arrTmp, 2)
arrRow(i) = arrTmp(1, i)
Next i
'the final array is combined to a single string value with " "(spaces) between each array element
'if the filterword is not found in the string Instr returns a 0
'If the filterword is found in the string InStr returns a number corresponding to the start position.
If InStr(1, Join(arrRow, " "), strFilterWord, vbTextCompare) > 0 Then
'Test to see if the range to delete is empty or not
If rngToDelete Is Nothing Then
'If the range is empty, it is set to the first row to delete.
Set rngToDelete = rngCell.EntireRow
Else
'if the range is not empty, the row to delete is added to the range.
Set rngToDelete = Union(rngToDelete, rngCell.EntireRow)
End If
End If
Next rngCell
'After all cells are looped over, the rows to delete are deleted in one go
If Not rngToDelete Is Nothing Then rngToDelete.Delete
End With
End Sub
答案 3 :(得分：0)
问题在于使用Selection。你应该avoid it at all costs！
如果数据始终位于同一区域，则变得非常简单。尝试类似：
Sub Button1_Click()
Dim cell As Range
Dim rData as Range
'Assigns the range for J22 and adjacent rows and columns
Set rData = ActiveSheet.Range("J22").CurrentRegion
word1 = InputBox("Enter a word by which you want to keep rows", "Enter")
For Each cell In rData
If (InStr(1, cell, word1, 1) = 0) then cell.EntireRow.Delete
Next cell
End Sub
当你不再使用Selection时，你的3分得到解决