我如何删除所有不包含特定值的行？

我一直在为此奋斗了几个小时，认为现在是时候请求帮忙了。

我有数百个电子表格，我想手动打开，然后使用macros简化。 每张电子表格都有一份医院名单（约400份），我想限制每份电子表格只显示100家医院的数据。 医院在三个字母的首字母缩略词中用不同的位置（行/列）表示，但总是标题为“代码”。

所以，例如，我希望macros删除所有不包含值“Code”，“ABC”，“DEF”，“GEH”等的行

我不是一个普通的Excel用户，只需要用它来解决这个问题…！

我已经试过附加的代码，但它有一些错误：

• 它也会删除包含“ABC”的行。 如果我定义了范围（“B1：B100”），但是如果范围跨越多个列（例如“A1：E100”），那么这个问题就会消失。 令人沮丧的是，电子表格中的“代码”列有所不同。
• 由于我想节省100个医院代码，所以感觉好像应该比使用“或”操作符100次更好。

谁能帮忙？

Sub Clean() Dim c As Range Dim MyRange As Range LastRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row Set MyRange = Range("A1:E100") For Each c In MyRange If c.Value = "Code" Then c.EntireRow.Interior.Color = xlNone ElseIf c.Value = "ABC" Or c.Value = "DEF" Then c.EntireRow.Interior.Color = vbYellow Else c.EntireRow.Delete End If Next End Sub 

Answer 1

尝试这个：

 Option Explicit Sub Clean() Dim rngRow As Range Dim rngCell As Range Dim MyRange As Range Dim blnDel As Boolean Dim lngCount As Long Set MyRange = Range("A1:E8") For lngCount = MyRange.Rows.Count To 1 Step -1 blnDel = False For Each rngCell In MyRange.Rows(lngCount).Cells If rngCell = "ABC" Then rngCell.EntireRow.Interior.Color = vbRed blnDel = True ElseIf rngCell = "DEF" Then rngCell.EntireRow.Interior.Color = vbYellow blnDel = True End If Next rngCell If Not blnDel Then Rows(lngCount).Delete Next lngCount End Sub 

一般来说，您需要遍历行，然后遍历每行中的每个单元格。 为了让程序记住某个行是否应该删除某些内容，在两个循环之间有一个blnDel ，如果没有findDEF或ABC ，就删除该行。

VBA中行删除中有问题的部分是，你应该小心删除总是正确的。 因此，你应该从最后一行开始进行反向循环。

Answer 2

 Option Explicit Sub Clean() Dim c As Range, MyRange As Range, DelRng As Range, Code As Range, CodeList As Range Dim CodeCol As Long, LastRow As Long ''Uncomment the below. I'd put all of your codes into one sheet and then test if the value is in that range 'With CodeListSheet ' Set CodeList = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)) 'End With ' Update this to point at the relevant sheet ' If you're looking at multiple sheets you can loop through the sheets starting your loop here With Sheet1 Set Code = .Cells.Find("Code") If Not Code Is Nothing Then CodeCol = Code.Column LastRow = .Cells(Cells.Rows.Count, CodeCol).End(xlUp).Row Set MyRange = .Range(.Cells(1, CodeCol), .Cells(LastRow, CodeCol)) For Each c In MyRange If c.Value2 = "Code" Then c.EntireRow.Interior.Color = xlNone '' Also uncomment this one to replace your current one 'ElseIf WorksheetFunction.CountIf(CodeList, c.Value2) > 0 Then ElseIf UCase(c.Value2) = "ABC" Or c.Value2 = "DEF" Then c.EntireRow.Interior.Color = vbYellow Else If DelRng Is Nothing Then Set DelRng = c Else Set DelRng = Union(DelRng, c) End If End If Next c If Not DelRng Is Nothing Then DelRng.EntireRow.Delete Else MsgBox "Couldn't find correct column" Exit Sub End If End With End Sub