按特定的单词内容删除或保留多行
我试图编写一个代码，删除或保留由最终用户input的特定单词的行。
我创build了两个button操作：
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 但是，这些button并不像我希望的那样工作。
问题：
1）我必须专门select要search的文本列中的单元格; 如果我select整个数据块，一切都将被删除。
2）实际上，如果程序从单元格J22向前（向右和向下）做了魔术直到数据结束，而不需要select任何东西，那么程序将更加便利。 做这个的最好方式是什么？
3）如果我连续多次使用这些button，我已经删除的行不断popup。 每次使用这些button之一时，如何使删除“永久”？ 通过将隐藏更改为删除，我开始得到运行时错误。
- 使用您当前的代码，如果您select了整个数据块，它将单独检查该select中的每个单元格，并相应地执行操作。 如果您select的范围类似于A1：J1,000，则会隐藏每一行，除非所选内容的每一行中的每个单元格都包含input单词。
- 根据你真正想要的东西，你可以尝试一些
Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.count, 10).End(xlUp).Row返回最后一个单元格的列10（J），在下面的代码中更多的例子 - 这是由for循环和删除行造成的，例如
For i = 1 To 100你检查单元格A1到A100，如果你在那个循环中删除了一行，循环将继续到100，而不是在99结束，循环的结束在循环开始之前设置，在循环中不会改变。 更多的信息，这是在这里的解决scheme。
一般
- 避免使用
.Select/.Activate方法和.Selection属性，它是很多错误的来源。 - 声明所有variables，使用
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
当你试图永久删除macros时，删除一行，将所有其他行向上移动一个以适应，这会中断“For Each … Next”的stream程。
有两种方法可以改变代码的形状。
其中之一就是在循环中将你想删除的行添加到联合中，然后删除循环外的联合（下面的例子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
另一种方法是在代码开始时定义要使用的确切范围，然后使用循环控制variables而不是每个循环在该范围内向后循环，这样当删除一行时，移位不会影响循环。
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
这应该做的伎俩
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模块中，然后testing它是否在先工作。
我做了testing，它为我工作。
注意使用删除Rows或Columns总是从列表的末尾开始，并按照自己的方式开始，这样引用不会混乱。
问题在于使用Selection 。 你应该不惜一切代价避免 ！
如果数据总是在相同的区域，这变得非常简单。 尝试像这样：
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点就可以解决了