Question

以下代码在用户键入userform文本框时循环遍历范围 - 并过滤列表。我想扩展它，所以用户可以键入例如＆＃34; word1 word2 word3＆＃34;并获得所有打字单词的所有匹配项。目前，一次只能使用一个单词。

Private Sub Search()

    Dim Cell As Range
    Dim sAddr As String
    Dim keepers()

    Dim sh As Worksheet

    Set sh = ThisWorkbook.Sheets("data")

    'Load alle
    Populateriskissuelist

    'Test for search string
    If Me.txtSearch.Value = vbNullString Then
        Exit Sub
    End If

    Set Cell = sh.Range(sh.Cells(2, 1), sh.Cells(getLastRowOf(sh), getLastColumnOf(sh, 1))).Find( _
    What:=Me.txtSearch.Text, _
    After:=sh.Cells(getLastRowOf(sh), getLastColumnOf(sh, 1)), _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlNext, _
    MatchCase:=False)

        If Not Cell Is Nothing Then
            sAddr = Cell.Address
            Do
                'Save in array
                ReDim Preserve keepers(k)
                keepers(k) = sh.Cells(Cell.Row, 1).Value    'ID
                k = k + 1

                Set Cell = sh.Range(sh.Cells(2, 1), sh.Cells(getLastRowOf(sh), getLastColumnOf(sh, 1))).FindNext(Cell)

            Loop While Cell.Address <> sAddr
        End If

    'Select found items
    If Not IsVarArrayEmpty(keepers) Then
        For i = LBound(keepers) To UBound(keepers)
            For j = 0 To Me.lstRiskissuelist.ListCount - 1
                If Me.lstRiskissuelist.List(j, 0) = keepers(i) Then
                    Me.lstRiskissuelist.selected(j) = True
                End If
            Next j
        Next i
    End If

    'delete non-selected
    With Me.lstRiskissuelist
        If .ListCount > 0 Then
            For i = .ListCount - 1 To 0 Step -1
               If .selected(i) = False Then
                    .RemoveItem (i)
                End If
            Next i
        End If
    End With

    'Clean up
    Set Cell = Nothing
    Set sh = Nothing
    Erase keepers

    End Sub

Answer 1

我用这个丑陋的检查程序做到了......

For i = 2 To lastRow

    sh.Range("BO2:BO100").ClearContents

    For j = 1 To lastCol
        For k = 2 To sh.Range("BN50").End(xlUp).Row
            If InStr(1, sh.Cells(i, j).Value, sh.Range("BN" & k).Value, vbTextCompare) Then
                  sh.Range("BO" & k).Value = "check"
            End If
        Next k
    Next j

    If Application.WorksheetFunction.CountA(sh.Range("BN2:BN100")) = Application.WorksheetFunction.CountA(sh.Range("BO2:BO100")) Then
        sh.Range("BP" & i).Value = "Include"
        'Include ROWNUMBER in cUnique
        On Error Resume Next
                cUnique.Add i, CStr(i)
        On Error GoTo 0
    Else
        sh.Range("BP" & i).Value = "Exclude"
    End If
Next i

展开vba .FIND以包含多个单词

1 个答案: