vba刪除不包含在範圍中定義的設置值的行

我有一張25k行的數據表。我需要在整個工作表中搜索特定字詞，這些字詞是在選項卡2的名爲範圍內定義的，名爲「KeywordSearh」。該範圍包含我需要在主數據中查找的單詞列表。我想刪除所有不包含這些關鍵詞的行（並且將所有保留行向上移動），並僅保留參考關鍵字（包括標題行）的行。關鍵字可以寫成任何單元格內的文本，也將包含其他文本，因此搜索功能需要查看每個字符串，而不是特定於案例。vba刪除不包含在範圍中定義的設置值的行

我認爲下面的鏈接上的代碼是接近的，但這不是指範圍。另外，我只需要搜索一個名爲「FAIR」的工作表。 VBA Looping Over Sheets: Delete rows if cell doesn't contain

我是VBA的完全新手，所以任何幫助都非常感謝。

來源

2013-09-26 Rachel Netto Redden

如果列表中的單詞與正在搜索的工作表中的單詞的部分匹配，該怎麼辦？該行不應該被刪除？例如：您的搜索列表包含「範圍」，數據表上的單元格具有「橙色」.. –

這是一個非VBA的方式來做到這一點。選擇要更改的範圍，轉到條件格式>突出顯示單元格規則>更多規則>使用公式確定要格式化的單元格。選擇一種顏色以突出顯示單元格，然後用您的範圍鍵入此公式：

=COUNTIF(FAIR!$A$1:$A$10,A1)其中FAIR！$ A $ 1：$ A $ 10是您的關鍵字範圍，A1是您嘗試更改範圍的第一個單元格。

然後，您可以通過顏色=無填充，選擇過濾你的清單，（僅按Ctrl + G>特殊>可見單元格）刪除唯一可見的細胞。下面

來源

2013-09-26 05:26:50

程序搜索您的整個工作表的值的數組，然後刪除工作表中的所有行，都沒有發現這些值。

此代碼是從其他網站改編的，出於某種原因我無法將鏈接粘貼到此處。

首先，你需要創建一個函數來找到最後一行：

Public Function GetLastRow(ByVal rngToCheck As Range) As Long 

    Dim rngLast As Range 

    Set rngLast = rngToCheck.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) 

    If rngLast Is Nothing Then 
     GetLastRow = rngToCheck.Row 
    Else 
     GetLastRow = rngLast.Row 
    End If 

End Function

現在，使用下面的代碼找到一個數組中的值。它將搜索整個工作表並刪除找不到該值的任何行。

Sub Example1() 

    Dim varList As Variant 
    Dim lngarrCounter As Long 
    Dim rngFound As Range, rngToDelete As Range 
    Dim strFirstAddress As String 

    Application.ScreenUpdating = False 

    varList = VBA.Array("Here", "There", "Everywhere") 'You will need to change this to reflect your Named range 

    For lngarrCounter = LBound(varList) To UBound(varList) 

     With Sheets("Fair").UsedRange 'Change the name to the sheet you want to filter 
      Set rngFound = .Find(_ 
           What:=varList(lngarrCounter), _ 
           Lookat:=xlWhole, _ 
           SearchOrder:=xlByRows, _ 
           SearchDirection:=xlNext, _ 
           MatchCase:=True) 

      If Not rngFound Is Nothing Then 
       strFirstAddress = rngFound.Address 

       If rngToDelete Is Nothing Then 
        Set rngToDelete = rngFound 
       Else 
        If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then 
         Set rngToDelete = Application.Union(rngToDelete, rngFound) 
        End If 
       End If 

       Set rngFound = .FindNext(After:=rngFound) 

       Do Until rngFound.Address = strFirstAddress 
        If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then 
         Set rngToDelete = Application.Union(rngToDelete, rngFound) 
        End If 
        Set rngFound = .FindNext(After:=rngFound) 
       Loop 
      End If 
     End With 
    Next lngarrCounter 

    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete 

    Application.ScreenUpdating = True 

End Sub

讓我知道你是否需要進一步的幫助。

來源

2013-09-26 06:26:23

vba刪除不包含在範圍中定義的設置值的行

回答

相關問題