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 

希望我能帮上忙。