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

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