Question

这是我想要的流程：

在“Sheet2”上，您可以选择宏“按名字搜索”
您会看到一个输入名称的弹出窗口，您输入一个名称（X）并选择确定
它将搜索下一张“Master”，并查找名字= X
最后将这些结果返回“Sheet2”

这是两张纸的截图：

第2页

Sheet2 和

主

Master

以下VB代码意味着它有时只返回1个结果：

Sub Searchbyfirstname()

Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String

Dim i As Long

Dim MyVal As String
MyVal = InputBox("Enter the first name of the employees record you need", "Search By First Name", "")

If MyVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Cells(5, 1)
    .Value = "The below data has been found for " & MyVal & ":"
    .EntireColumn.AutoFit
    .HorizontalAlignment = xlCenter
End With
i = 2

For Each wks In ActiveWorkbook.Worksheets
     If wks.Name <> "List" Then

        With wks.Range("B:B")

            Set rCell = .Find(MyVal, , , xlWhole, xlByColumns, xlNext, False)
            If Not rCell Is Nothing Then
                fFirst = rCell.Address
                Do
                    rCell.Hyperlinks.Add Cells(6, 1), "", "'" & wks.Name & "'!" & rCell.Address
                    wks.Range("A" & rCell.Row & ":Z" & rCell.Row).Copy Destination:=Cells(6, 1)
                    Set rCell = .FindNext(rCell)
                    i = i + 3 
                Loop While Not rCell Is Nothing And rCell.Address <> fFirst
            End If
        End With
     End If

Next wks

Set rCell = Nothing

If i = 2 Then
    MsgBox "No record for " & MyVal & " has been found", 64, "No Matches"
    Cells(1, 1).Value = ""
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

非常感谢任何帮助，谢谢！

Answer 1

好的，所以我很确定我现在有了答案Maertin和chris neilsen用硬编码指出错误。

我已经再次发布了我的代码，但我添加或更改的内容不是代码（不知道格式化的最佳方式）：

Sub Searchbyfirstname()

Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String

Dim i As Long

Dim MyVal As String
MyVal = InputBox("Enter the first name of the employees record you need",         "Search By First Name", "")

If MyVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Cells(5, 1)
.Value = "The below data has been found for " & MyVal & ":"
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
i = 2

For Each wks In ActiveWorkbook.Worksheets
 If wks.Name <> "List" Then

    With wks.Range("B:B")

        Set rCell = .Find(MyVal, , , xlWhole, xlByColumns, xlNext, False)

        If Not rCell Is Nothing Then

            fFirst = rCell.Address

Dim x As Integer

x = 6

使用表格（“Sheet2”）

.Rows（6＆amp;“：”＆amp; .Rows.Count）。删除

结束

'对于这部分，我创建了变量x，然后我分配了这个6，因为那是我想要放入数据的第一行，然后我说如果第6行或者下面有任何内容，请将其删除< / p>

            Do

rCell.Hyperlinks.Add Cells(x, 1), "", "'" & wks.Name & "'!" & rCell.Address

'看到这个和下面的行，而不是单元格（6,1），它现在是x，这意味着它将粘贴到6，然后如果还有另外7个等等

                wks.Range("A" & rCell.Row & ":Z" & rCell.Row).Copy Destination:=Cells(x, 1)

                Set rCell = .FindNext(rCell)
                i = i + 3

x = x + 1

'在这里，我将x递增1，这样如果要粘贴另一条数据，它将粘贴到下一行 - 首先，这将是第7行

            Loop While Not rCell Is Nothing And rCell.Address <> fFirst
        End If
    End With
 End If 

Next wks

Set rCell = Nothing

If i = 2 Then
MsgBox "No record for " & MyVal & " has been found", 64, "No Matches"
Cells(1, 1).Value = ""

With Sheets("Sheet2")
.Rows(5 & ":" & .Rows.Count).Delete
End With

End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

如何搜索一张数据并在另一张纸上返回MULTIPLE匹配结果？

1 个答案: