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 键。

如果您希望搜索超过 1 个关键字，可以使用以下循环：

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 

希望能帮到你。