將vba .FIND擴展爲包含多個單詞

以下代碼在用戶在userform文本框中鍵入時循環顯示一個範圍 - 並過濾列表。我想擴大這個，所以用戶可以輸入例如「word1 word2 word3」，並獲得所有打字的所有匹配。目前只能使用一個字。將vba .FIND擴展爲包含多個單詞

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

來源

2016-10-27 preston

作爲find方法返回一個範圍對象，我想看看'union'在每個3範圍相結合的發現也許？ –

現在我正在試驗循環一個數組，其中「」是分隔符（人們用空格分隔單詞）：xArr = Split（Me.txtSearchKB.Text，「」） – preston

但它不工作:) – preston

我這個醜陋的例行檢查做到了......

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

來源

2016-10-28 09:55:11 preston

將vba .FIND擴展爲包含多個單詞

回答

相關問題