Question

我正在努力使用以下代码，您可以在下面看到。现在，这完全是一种痛苦。我真的需要一些帮助。此代码是一个搜索工具，它查找除摘要和列表之外的每个工作表的条件。在.Find找到单词之后，代码在搜索到的单词周围选择4个宽范围，然后将其复制并粘贴到摘要表上。当找到第一个搜索到的单词时，我还想在摘要页面上的搜索结果之后立即复制并粘贴实际工作表（找到单词的位置）标题（在每个工作表“G3：J3”上）。这个搜索工具可以帮助我快速找到哪些搜索条件可以找到，哪个表格以及标题内的一些属性。

结果应如下所示：（r1 =前4列，r2 =其余4列（即excel标题））

项目编号项目所有者使用的容量ESD_nr。框所有者可用容量位置

很抱歉有很长的描述。

CODE：

Private Sub searchTool()

Dim ws As Worksheet, OutputWs As Worksheet, wbName As Worksheet
Dim rFound As Range, r1 As Range, r2 As Range, multiRange As Range
Dim strName As String
Dim count As Long, lastRow As Long
Dim IsValueFound As Boolean

IsValueFound = False
Set OutputWs = Worksheets("Summary")    '---->change the sheet name as required
lastRow = OutputWs.Cells(Rows.count, "K").End(xlUp).Row

On Error Resume Next
strName = ComboBox1.Value
If strName = "" Then Exit Sub
For Each ws In Worksheets

    If ws.Name <> "lists" And ws.Name <> "Summary" Then

        With ws.UsedRange

            Set rFound = .Find(What:=strName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not rFound Is Nothing Then
                firstAddress = rFound.Address

                Do

                IsValueFound = True
                Set r1 = Range(rFound.EntireRow.Cells(1, "B"), rFound.EntireRow.Cells(1, "D"))
                Set r2 = Range("G3:J3")
                Set multiRange = Application.Union(r1, r2)
                multiRange.Copy
                OutputWs.Cells(lastRow + 1, 11).PasteSpecial xlPasteAll
                Application.CutCopyMode = False
                lastRow = lastRow + 1
                Set rFound = .FindNext(rFound)

                Loop While Not rFound Is Nothing And rFound.Address <> firstAddress

            End If
        End With
    End If
Next ws
On Error GoTo 0
If IsValueFound Then
   OutputWs.Select
   MsgBox "Seach complete!"

Else
    MsgBox "Name not found!"
End If

End Sub

Answer 1

我必须承认我在遵守您的要求时遇到了麻烦，并且没有定义它不起作用的地方，为此我重新写了它以帮助我理解。

Private Sub SearchTool_2()
Dim BlnFound        As Boolean
Dim LngRow          As Long
Dim RngFind         As Excel.Range
Dim RngFirstFind    As Excel.Range
Dim StrName         As String
Dim WkShtOutput     As Excel.Worksheet
Dim WkSht           As Excel.Worksheet

StrName = "Hello" 'ComboBox1.Value
If StrName = "" Then Exit Sub

Set WkShtOutput = ThisWorkbook.Worksheets("Summary")
    LngRow = WkShtOutput.Cells(WkShtOutput.Rows.count, "K").End(xlUp).Row + 1
    For Each WkSht In ThisWorkbook.Worksheets
        If (WkSht.Name <> "lists") And (WkSht.Name <> "Summary") Then
            With WkSht.UsedRange
                Set RngFind = .Find(What:=StrName, LookIn:=xlValues, LookAt:=xlWhole)
                If Not RngFind Is Nothing Then
                    Set RngFirstFind = RngFind
                    BlnFound = True
                    Do
                        WkSht.Range(RngFind.Address & ":" & WkSht.Cells(RngFind.Row, RngFind.Column + 2).Address).Copy WkShtOutput.Range(WkShtOutput.Cells(LngRow, 11).Address)
                        WkSht.Range("G3:J3").Copy WkShtOutput.Range(WkShtOutput.Cells(LngRow + 1, 11).Address)
                        LngRow = LngRow + 2
                        Set RngFind = .FindNext(RngFind)
                    Loop Until RngFind.Address = RngFirstFind.Address
                End If
            End With
        End If
    Next
Set WkShtOutput = Nothing

If BlnFound Then
   ThisWorkbook.Worksheets("Summary").Select
   MsgBox "Seach complete!"
Else
    MsgBox "Name not found!"
End If

End Sub

我发现复制语句是更好的选择，而不是使用剪贴板，我还发现缺少firstAddress的引用。

使用.find，.findnext变量选择多范围（复制EMPTY单元格）

1 个答案: