用“AND”和“OR”search参数

这里是一个例子程序如何工作（现在）

例如，如果用户search单词“apple”，程序将search单词“apple”，并将整行加上标题传递到新的工作表上。 喜欢这个，

注意到那两个有“苹果”一词的行被传到了一张新纸上，这很好。 但是现在，我试图实现一种方法来search这两个单词中的单词，并为了实现，我认为最好的方法是使用“AND”和“OR”函数。

这意味着如果用户search“苹果”和“梨”，那么第一行（加标题）将被传递到新的工作表，而不是先前将两行传递到新的工作表。

而对于“或”function，例如如果用户selectsearch一个单词，例如“蓝色”或“紫色”（显然在原始数据中不存在），程序将通过“蓝色“（整行+标题），但如果这样的情况下，两个字都存在，程序将通过行（和标题）

这是我正在使用的当前代码。

编辑

Dim search1, search2 As String Dim searchinput As String Dim searcharray() As String Dim display As String Dim y As Long Dim LastNonEmpty As Integer Dim rLastCell As Range Dim i As Long, nRowsAddePerSheet As Long, nRows As Long, _ nRowsMax As Long, nSheets As Long Dim x Dim rg As Range, rgF As Range, rgFF As Range Dim wks Set rLastCell = ActiveSheet.Cells.Find(What:="*", After:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False) LastNonEmpty = -1 searchinput = Application.InputBox("type in please") searcharray() = Split(searchinput) 'For y = 0 To 2 If searcharray(1) <> "AND" Then searcharray(1) = searcharray(2) End If nSheets = Sheets.count nRowsMax = ActiveSheet.Rows.count For x = 1 To 2 'nSheets On Error Resume Next Set wks = Worksheets("testsearch") If (Err) Then Set wks = Worksheets.Add(After:=Sheets(Sheets.count)) wks.Name = "testsearch" Err.Clear End If On Error GoTo 0 Sheets(x).Activate Set rg = ActiveSheet.Cells(1).CurrentRegion nRows = rg.Rows.count nRowsAddePerSheet = 0 For i = 1 To nRows Set rgF = rg.Rows(i).Find(searcharray(0), , xlValues, xlWhole) Next For i = 1 To nRows Set rgFF = rg.Rows(i).Find(searcharray(1), , xlValues, xlWhole) Next If rgF.Row <> rgFF.Row Then If Not rgF Is Nothing Then If (nRowsAddePerSheet <= 0) Then If (i <> 1) Then rg.Rows(1).Copy wks.Range("A" & nRowsMax).End(xlUp).Offset(1, 0) End If End If rg.Rows(i).Copy wks.Range("A" & nRowsMax).End(xlUp).Offset(1, 0) nRowsAddePerSheet = nRowsAddePerSheet + 1 End If Else MsgBox "cannot find" End If Next 'Next Set rgFF = Nothing Set rgF = Nothing Set rg = Nothing Set wks = Nothing Application.ScreenUpdating = True 

@ L4D2这个程序将参数分成三个单词并单独search（忽略单词“AND”），当find两个单词时，它们将根据它们的行进行比较，如果它们都存在于同一行，程序会将它们传递到一张新纸上，但是我能够做到这一点，但是它总共将它们传递到同一张纸上。 我想知道为什么..

Answer 1

我想你可以尝试做这样的事情：

 '... 'input string strSearch = Application.InputBox("Please enter the search string - two words separated by a space") 'split it into words strParts = Split(strSearch, " ") countOfWords = UBound(strParts) 'check if user has entered exactly two words If countOfWords = 0 Then MsgBox "You have entered only one word" Exit Sub ElseIf countOfWords > 1 Then MsgBox "You have entered more than two word" Exit Sub End If 'do something For i = 1 To nRows Set rgF_1 = rg.Rows(i).Find(strParts(0), , xlValues, xlWhole) Set rgF_2 = rg.Rows(i).Find(strParts(1), , xlValues, xlWhole) If (Not rgF_1 Is Nothing) AND (Not rgF_2 Is Nothing) Then ' do something Else If (Not rgF_1 Is Nothing) OR (Not rgF_2 Is Nothing) Then ' do something End If Next 

Answer 2

这是我该怎么做的。 允许您的用户在strSearch中input多个单词（可能由空格分隔）。 然后检查strStearch与InStr，看它是否包含一个空格（你可能想要确保它不包含多个）。 如果是，则将strSearch分割为两个variables，即空格左侧的string和空格右侧的string（使用LEFT，RIGHT和INSTR）。 您已经使用strSearch2作为您的工作表名称，所以让我们调用正确的string（如果存在）strSearchB，并重新定义strSearch作为左边的string。

现在你可以声明另一个范围rgFB来searchstrSearchB（如果存在的话）并且在你的循环中有声明

 If Not rgF Is Nothing Or If Not rgFB Is Nothing Then 

Answer 3

我很难debugging你的代码，所以我做了一个版本。
见下文：

主要小组：
这将检查input并决定它是否正确。
它也决定是否执行AND sub或OR sub
（取决于input过程中使用的分隔符）
只接受2个字，不多，不less。

 Option Explicit Sub test() Dim ws As Worksheet Dim search_rng As Range, lastcell As Range Dim lrow As Long Dim search_size As Boolean Dim search_input As String Dim search_string As Variant Set ws = ThisWorkbook.Sheets("Sheet3") Set search_rng = ws.Range("A1:D4") Set lastcell = search_rng.Cells(search_rng.Cells.count) search_input = InputBox("Enter word(s) you want to search." & vbNewLine & _ "Note: Separate by comma for AND, semi-colon for OR") If InStr(search_input, ",") > 0 Then search_string = Split(search_input, ",") search_size = IIf(UBound(search_string) = 1, True, False) If search_size Then ANDSearch search_string(0), search_string(1), search_rng, lastcell Else MsgBox "You entered to many arguments" Exit Sub End If ElseIf InStr(search_input, ";") > 0 Then search_string = Split(search_input, ";") search_size = IIf(UBound(search_string) = 1, True, False) If search_size Then ORSearch search_string, search_rng, lastcell Else MsgBox "You entered to many arguments" Exit Sub End If Else MsgBox "Invalid input" End If End Sub 

支持子（和）：
这将复制包含两个单词的所有行。

 Private Sub ANDSearch(my_search1 As Variant, my_search2 As Variant, _ my_range As Range, end_cell As Range) Dim foundcell As Range, sub_range As Range Dim firstaddr As String Dim ws As Worksheet Dim check As Boolean Dim count As Integer count = 0 Set ws = ThisWorkbook.Sheets("Sheet4") Set foundcell = my_range.Find(my_search1, end_cell, xlValues, xlWhole, xlByColumns) If Not foundcell Is Nothing Then firstaddr = foundcell.Address End If Do Until foundcell Is Nothing '~~>just based on your sample data, change column number or make it dynamic Set sub_range = foundcell.EntireRow.Resize(, 4) check = IsError(Application.Match(my_search2, sub_range, 0)) If Not check Then If count = 0 Then my_range.Resize(1).Copy ws.Range("A" & ws.Range("A" & Rows.count).End(xlUp).Row) sub_range.Copy ws.Range("A" & ws.Range("A" & Rows.count).End(xlUp).Row).Offset(1, 0) count = count + 1 End If Set foundcell = my_range.FindNext(foundcell) If foundcell.Address = firstaddr Then Exit Do End If Set sub_range = Nothing Loop End Sub 

支持子（OR）：
这将复制连续出现的所有单词。

 Private Sub ORSearch(my_search As Variant, my_range As Range, end_cell As Range) Dim count As Integer, i As Integer Dim foundcell As Range, sub_range As Range Dim firstaddr As String Dim ws As Worksheet count = 0 Set ws = ThisWorkbook.Sheets("Sheet4") For i = LBound(my_search) To UBound(my_search) Set foundcell = my_range.Find(my_search(i), end_cell, xlValues, xlWhole, xlByColumns) If Not foundcell Is Nothing Then firstaddr = foundcell.Address If count = 0 Then my_range.Resize(1).Copy ws.Range("A" & ws.Range("A" & Rows.count).End(xlUp).Row) count = count + 1 End If Do Until foundcell Is Nothing Set sub_range = foundcell.EntireRow.Resize(, 4) sub_range.Copy ws.Range("A" & ws.Range("A" & Rows.count).End(xlUp).Row).Offset(1, 0) Set foundcell = my_range.FindNext(foundcell) If foundcell.Address = firstaddr Then Exit Do End If Loop Next End Sub 

这正是你所描述或几乎。
没有做过很多testing。
有点粗糙的代码和缓慢的执行，但至less这可能会给你一个暗示，以达到你想要的。
OR sub也有局限性。
例如inputapple;pear结果如下：

因为它输出每个单词的所有出现。
我不知道你想要什么，你没有把它包括在你的问题中。
如果以某种方式，你不希望重复条目，那么在完成第一个单词之后，按照AND sub逻辑来调整OR sub 。