Excel VBA中的復選框搜索

Question

這是我第一次參加這個論壇。 我是excel VBA中的“新手”，如果有人可以提供幫助，我們將不勝感激。

我正在嘗試開發一個復選框搜索頁面，其中：

• 用戶可以使用復選框選擇最多4個項目進行搜索（在“搜索”工作表中）
• 在數據表中，數據記錄如下（按列）：

代碼本項目物料1百分比1物料2百分比2物料3百分比3物料4百分比4

• 一個項目（例如“聚酯”）將出現在“材料1”，“ 2”等列中，具體取決於記錄
• 搜索應基於搜索頁面中選中的復選框
• 如果選中了多個關鍵字，例如聚酯，羊毛，棉花，則應僅顯示所有3個關鍵字的行

我在網上搜索了無數帖子，有一個帖子在找到關鍵字的情況下會刪除行。 我有什么辦法可以改變邏輯並適用於這種特殊情況？

被困了很多天...如果有人可以幫助，不勝感激！

更新1：我已經設法在互聯網上找到一些可以找到某些關鍵字的行，但這些行會刪除行-但是，我想做相反的事情（這將使我剩下的正確關鍵字...）

如下代碼-是否可以更改？

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")

    For lngarrCounter = LBound(varList) To UBound(varList)
        With Sheet1.UsedRange
            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

Answer 1

也許您可以嘗試Sheets("Search").Cells.Find([keyword]) ctrl + L鍵的Sheets("Search").Cells.Find([keyword])命令。

如果您希望搜索多個關鍵字，則可以使用以下循環：

dim i as Integer
dim vTemp as Variant
dim strFind as String
dim objSearch as Object

strFind = range("searchField").value
vTemp = split(strFind, ",")

for i =0 to Ubound(vTemp)
    Set objSearch  = Sheets("Search").Cells.Find(vTemp(i))
    'Do whatever you like to the object of search
next i 

希望我能幫上忙。