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

Question

我一直在为此奋斗了几个小时，并认为现在可能是时候寻求帮助。

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

因此，举例来说，我想宏观上删除不包含值“代码”，“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，如果找不到DEF或，则删除该行。

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