Question

这是程序如何工作的例子（现在）

data

例如，如果用户搜索单词“apple”，程序将搜索单词“apple”并将整行和标题传递到新表单上。像这样，

enter image description here

注意到那两个单词“apple”被传递到一张新表上，这很好。但是现在，我正在尝试实现一种方法来搜索单行中的单词并实现这一目标，我认为最好的方法是使用“AND”和“OR”函数。

意思是如果用户搜索“apple”和“pear”，则第一行（加上标题）将传递到新工作表而不是先将两行传递到新工作表上。

和“OR”功能，例如，如果用户选择搜索任何一个单词，例如“蓝色”或“紫色”（原始数据中显然不存在），程序将传递“蓝色”（整行+标题），但如果这两个字存在的情况，程序将传递行（和标题）

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

被修改

    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这个程序将参数分成三个单词并单独搜索它们（忽略单词“AND”），当找到两个单词时，如果两个单词都存在，它们将按行进行比较。在同一行，程序会将它们传递给一个新的工作表，但是我能够做到但是它总共将它们传递到同一张纸上。我想知道为什么..

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中输入多个单词（可能由空格分隔）。然后使用InStr检查strStearch以查看它是否包含空格（您可能希望确保它不包含多个空格）。如果是，则将strSearch拆分为两个变量，即空格左侧的字符串和空格右侧的字符串（使用LEFT，RIGHT和INSTR）。您已经使用strSearch2作为工作表名称，所以让我们调用正确的字符串（如果存在）strSearchB，并将strSearch重新定义为左字符串。

现在你可以声明另一个范围rgFB来搜索strSearchB（如果它存在）并在你的循环中有声明

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

Answer 3

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

主要分：
这将检查输入并确定它是否正确它还决定是执行AND sub还是OR sub （取决于输入时使用的分隔符）
只接受2个单词，不多也不少。

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

这完全是你所描述或几乎所描述的没有做过很多测试有点粗糙的代码和缓慢的执行，但至少这可能会给你一个提示，以实现你想要的 OR sub也有局限性例如，输入apple;pear会导致此结果：

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

使用“AND”和“OR”搜索参数

3 个答案: