如何找到包含多個值的單元格？

我已經嘗試了查找功能，但它只搜索單個值...我需要搜索包含同一單元格內的多個值的單元格。即......包含「新」「汽車」「紅色」的單元格如何找到包含多個值的單元格？

編輯1，這是我現在所擁有的......非常感謝您的評論和幫助。它現在正在努力，我將不勝感激進一步優化。

Private Sub Run_Click() 
Dim Val As Variant, v5 As Range, Count As Long, Temp1 As String, Temp2 As String, Temp3 As String 
Dim pos1, pos2, pos3 As Integer 
Dim Centinel1, Centinel2 As Boolean 
Centinel1 = True 
While Centinel1 = True 
    i = 2 
    Val = Cells(i, 1).Value 
    If Val <> "" Then 
     Count = 0 

     ' Gather values from source 

     v1 = Cells(i, 1).Value 
     v2 = Cells(i, 2).Value 
     v3 = Left(Cells(i, 3).Value, 3) 
     v4 = Mid(Cells(i, 3).Value, InStrRev(Cells(i, 3).Value, "-") - 2, 2) 

     Centinel2 = True 
     Temp1 = "$B$2" 

     While Centinel2 = True 
       Set v5 = Sheets("RWI").Range("B1:B1000").Find(What:=v1, After:=Range(Temp1)) 
       pos1 = InStr(v5, v2) 
       pos2 = InStr(v5, v3) 
       pos3 = InStr(v5, v4) 

       Temp2 = v5.Address 

       GetTail1 = Mid(Temp1, InStrRev(Temp1, "$") + 1) 
       GetTail2 = Mid(Temp2, InStrRev(Temp2, "$") + 1) 

       'Check if all matches are within "Find" 

       If pos1 > 1 And pos2 > 1 And pos3 > 1 Then 

        MsgBox v5 & " " & Sheets("RWI").Range(v5.Address).Offset(, -1) 
        Centinel2 = False 

       ElseIf Temp1 > Temp2 Then 

        MsgBox "Description not found." 
        Centinel2 = False 

       Else 

        Temp1 = v5.Address 

       End If 

     Wend 

     i = i + 1 

     Centinel1 = False 
    Else 
     Centinel1 = False 
    End If 
Wend

末次

編輯3：這是我的代碼看起來像現在......

Private Sub Run_Click() 

Dim Val As Variant, v5 As Range, Count As Long, i As Long 
Dim GetTail1, GetTail2 As Long 
Dim Cellsave, Temp1, Temp2, Temp3, v1, v2, v3, v4, R, Sheet, v0, v22 As String 
Dim pos1, pos2, pos3 As Integer 
Dim Centinel1, Centinel2, Centinel3 As Boolean 

If RWbutton.Value = True Then 
    R = "RW-" 
    Sheet = "RW Overflow Sheet" 
ElseIf RWIbutton.Value = True Then 
    R = "RWI-" 
    Sheet = "RWI Overflow Sheet" 
End If 

Centinel1 = True 
i = 2 

If Me.ResultsCol.Value = "" Then 
    MsgBox "Please input valid column letter to save results at" 
Else 
    While Centinel1 = True 
     Val = Sheets(Sheet).Cells(i, 1).Value 
     If Val <> "" Then 
      Count = 0 

      Centinel3 = False 

      ' Gather values from source 
      v0 = R 
      v1 = "-" & Sheets(Sheet).Cells(i, 1).Value & "-" 

      ' Check if v2 has - or (A or B) 
      If Sheets(Sheet).Cells(i, 2).Value Like "*-*" And (Sheets(Sheet).Cells(i, 2).Value Like "*A*" Or Sheets(Sheet).Cells(i, 2).Value Like "*B*") Then 
       v2 = Left(Sheets(Sheet).Cells(i, 2).Value, Application.Find("-", Sheets(Sheet).Cells(i, 2).Value) - 1) & "-" 
       v22 = Right(Sheets(Sheet).Cells(i, 2).Value, 1) 
       Centinel3 = True 
      ElseIf Sheets(Sheet).Cells(i, 2).Value Like "*-*" Then 
       v2 = "-" & Right(Sheets(Sheet).Cells(i, 2).Value, (Len(Sheets(Sheet).Cells(i, 2).Value) - InStrRev(Sheets(Sheet).Cells(i, 2).Value, "-"))) 
      Else 
       v2 = Sheets(Sheet).Cells(i, 2).Value & "-" 
      End If 

      v3 = Left(Sheets(Sheet).Cells(i, 3).Value, 3) 
      v4 = Right(Sheets(Sheet).Cells(i, 3).Value, (Len(Sheets(Sheet).Cells(i, 3).Value) - InStrRev(Sheets(Sheet).Cells(i, 3).Value, "/"))) 

      Cellsave = Me.ResultsCol.Value & i 
      Centinel2 = True 
      Temp1 = "$B$1" 

      While Centinel2 = True 
        Set v5 = Sheets("fnd_gfm").Range("B1:B1000").Find(What:=v0, After:=Range(Temp1)) 


        If (Not v5 Is Nothing) Then 
         pos1 = InStr(v5, v1) 
         pos2 = InStr(v5, v2) 
         pos3 = InStr(v5, v3) 
         pos4 = InStr(v5, v4) 

         Temp2 = v5.Address 


         GetTail1 = Mid(Temp1, InStrRev(Temp1, "$") + 1) 
         GetTail2 = Mid(Temp2, InStrRev(Temp2, "$") + 1) 

         'Check if all matches are within "Find" 
         If pos1 > 1 And pos2 > 1 And pos3 > 1 And pos4 > 1 Then 

           'Check if Part Number has A or B in it 
           If Centinel3 = False Then 
            Sheets(Sheet).Range(Cellsave).Value = Sheets("fnd_gfm").Range(v5.Address).Offset(, -1) 
            Centinel2 = False 

           ElseIf Centinel3 = True Then 
            Sheets(Sheet).Range(Cellsave).Value = Left(Sheets("fnd_gfm").Range(v5.Address).Offset(, -1).Value, (Len(Sheets("fnd_gfm").Range(v5.Address).Offset(, -1).Value) - 1)) & v22 
            Centinel2 = False 
            Centinel3 = False 

           End If 

          ElseIf GetTail1 > GetTail2 Then 

           'Check when Find does not find the value 
           Sheets(Sheet).Range(Cellsave).Value = "Not found." 
           Centinel2 = False 


          Else 

           Temp1 = v5.Address 

         End If 

        Else 

         Sheets(Sheet).Range(Cellsave).Value = "Not found." 
         Centinel2 = False 

        End If 

      Wend 

      i = i + 1 

     Else 
      Centinel1 = False 
      MsgBox "Process Finished" 
     End If 
    Wend 
End If

末次

來源

2017-07-13 Fabian Gutierrez

嘗試一個單獨檢查單元格的循環。如果您發現特定的問題，請發佈您的代碼，我們將很樂意幫助您解決問題並加以改進。 –

就像@ASH所說的那樣，你需要循環，但是它可能會**最好是循環使用一個**的Find，然後在這個循環內測試'Find'查看找到的單元格是否與其他術語匹配。（很大程度上取決於您的數據結構和數量。） – YowE3K

明天我就可以做到了。非常感謝！ –

更新：該代碼已得到增強，稍微有點用戶友好，因爲我可以看到有一天我想要使用它。它使用數組通過輸入框存儲文本字段，因此搜索項的數量很多。

 Sub FindLots() 
     Dim TextArray() As String, WS As Worksheet, Targetcell As Range 
     Dim Answer As String, StartingAddress As String 
     Dim AllSearchText As String, QuestionHeader As String 
     Dim I As Integer, t As Integer, NumericAnswer As Integer 
     Dim NoMemberFound As Boolean 

StartQuestion: 
     If I = 0 Then 
      QuestionHeader = "Enter Your Search Text" 
     Else 
      QuestionHeader = "Enter Your Search... part " & I + 1 & " !" 

     End If 

     Answer = InputBox("Add a field to search for and hit ""OK."" You will get a chance to enter search fields.", QuestionHeader, "Enter Text") 

     If Answer = "" Then 
      NumericAnswer = MsgBox("You didn't enter anything. Click ""Yes"" to try again. ""No"" to start search or ""Cancel"" to... cancel.", vbYesNoCancel, "Oh False!") 

      If NumericAnswer = vbYes Then 
       GoTo StartQuestion 
      ElseIf NumericAnswer = vbCancel Then 
       Exit Sub 
      End If 
     Else 

      ReDim Preserve TextArray(I) 
      TextArray(I) = Answer 
      AllSearchText = AllSearchText & "," & Answer 

      NumericAnswer = MsgBox("Would you like to add an additional members to search of """ & AllSearchText & """? Click no to continue search.", vbQuestion + vbYesNoCancel) 
       If NumericAnswer = vbYes Then 
        I = I + 1 
        GoTo StartQuestion 
       ElseIf NumericAnswer = vbCancel Then 
        Exit Sub 
       End If 
     End If 

     On Error Resume Next 
     If TextArray(0) = "" Then 
      MsgBox "No Search text entered", vbCritical 
      Exit Sub 
     End If 
     On Error GoTo 0 


    Set WS = ActiveSheet 'or whatever sheet you want to search 

    Set Targetcell = WS.Cells.Find(TextArray(0), WS.Cells(1, 1)) 

    If Targetcell Is Nothing Then 
     MsgBox "coulnd't even find " & TextArray(0), vbCritical 
     Exit Sub 
    ElseIf I = 0 Then 
     MsgBox "Found your cell at " & Targetcell.Address 
     Targetcell.Select 
     Exit Sub 
    End If 

    StartingAddress = Targetcell.Address 

    Do 
    NoMemberFound = False 
    For t = 1 To I 

    If Targetcell.Cells.Find(TextArray(t)) Is Nothing Then 
     NoMemberFound = True 
     Exit For 
    End If 
    Next t 

    If NoMemberFound = False Then 
     MsgBox "Found your cell at " & Targetcell.Address, , "Yea!" 
     Targetcell.Select 
     Exit Sub 
    End If 

    Set Targetcell = WS.Cells.Find(TextArray(0), Targetcell) 

    Loop Until Targetcell.Address = StartingAddress 

    MsgBox "Unable to find cells with your criteria of " & Right(AllSearchText, Len(AllSearchText) - 1), vbInformation, "Is that bad?" 

    End Sub

來源

2017-07-13 01:01:42 PGCodeRider

如何找到包含多個值的單元格？

回答

相關問題