在VBA中搜索整个工作簿,然后将结果粘贴到另一个工作表中

时间:2017-06-16 12:45:38

标签: excel vba excel-vba

首先,在信用到期时给予信用。这是使用来自Mr.Excel.com和exceltip.com的来自u / Joe的代码放在一起。

现在我已经解决了这个问题,我试图创建一个搜索功能,它将搜索excel中的9张工作表文档,找到一个输入搜索框的值。然后将这些值粘贴到工作簿的第一页。

我需要在代码中更改哪些内容才能将其粘贴到搜索页面上的正确位置?我已经尝试在最后一个循环中更改内容,因为这是我得到“运行时错误91.对象变量或未设置块变量”的地方。

我用谷歌搜索了这个错误,但变量总是让我感到困惑,这可能是问题所在。 The search page. This is where the Debugger stops. 到目前为止,这是我的代码。

Sub Find_one()
'Find Function For ERF Spreadsheet'
'Type in Box, Press Button, Display the Results'
    Dim ws As Worksheet, Found As Range
    Dim myText As String, FirstAddress As String
    Dim AddressStr As String, foundNum As Integer

        myText = Range("D5")

            If myText = "" Then Exit Sub

                For Each ws In ThisWorkbook.Worksheets
                    With ws
                    'Do not search sheet1'
                        If ws.Name = "Sheet1" Then GoTo myNext

                            Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

                        If Not Found Is Nothing Then
                            FirstAddress = Found.Address

                        Do
                            foundNum = foundNum + 1
                            AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf

                        Set Found = .UsedRange.FindNext(Found)

                        'Found.EntireRow.Copy _
                        'Destination:=Worksheets("Sheet4").Range("A65536").End(xlUp).Offset(1, 0)
                        Loop While Not Found Is Nothing And Found.Address <> FirstAddress
            End If

myNext:
                    End With

    Next ws

    If Len(AddressStr) Then

            Sheet8.Range("B18") = ws.Cells(x, 1)
            Sheet8.Range("C18") = ws.Cells(x, 2)
            Sheet8.Range("D18") = ws.Cells(x, 3)
            Sheet8.Range("E18") = ws.Cells(x, 4)
            Sheet8.Range("F18") = ws.Cells(x, 5)
            Sheet8.Range("G18") = ws.Cells(x, 6)
            Sheet8.Range("H18") = ws.Cells(x, 7)
            Sheet8.Range("I18") = ws.Cells(x, 8)
            Sheet8.Range("J18") = ws.Cells(x, 9)

    Else:
            MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
    End If

End Sub

这是最后一个循环的原始代码......

If Len(AddressStr) Then

    MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
    AddressStr, vbOKOnly, myText & " found in these cells"

Else:

    MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation

End If

1 个答案:

答案 0 :(得分:0)

在这里,尝试一下。我重写了我对第一部分的解释。我并不完全确定您要对所有内容做些什么,所以请告诉我这是否有效或哪里出错。

Sub FindOne()
    Dim k As Integer
    Dim myText As String, searchColumn As String
    Dim totalValues As Long
    Dim nextCell As Range

    k = ThisWorkbook.Worksheets.Count
    myText = Sheets(1).Range("D5").Value

    If myText = "" Then
        MsgBox "No Address Found"
        Exit Sub
    End If

    Select Case ComboBox1.Value
        Case "Equipment Number"
            searchColumn = "A"
        Case "Sequence Number"
            searchColumn = "B"
        Case "Repair Order Number(s)"
            searchColumn = "D"
        Else
            MsgBox "Please select a value for what you are searching by."
            End Sub
    End Select

    For i = 2 To k
        totalValues = Sheets(i).Range("A65536").End(xlUp).Row
        ReDim AddressArray(totalValues) As String

        For j = 0 To totalValues
            AddressArray(j) = Sheets(i).Range(searchColumn & j + 1).Value
        Next j

        For j = 0 To totalValues
            If (InStr(1, AddressArray(j), myText) > 0) Then
                Set nextCell = Sheets(1).Range("A65536").End(xlUp).Offset(1, 0)
                Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(i).Range("A" & j, "I" & j).Value
            End If
        Next j
    Next i

End Sub

此外,我不知道代码的第二部分应该是什么,所以如果你想详细说明If Len(AddressStr) Then的部分,我会很感激,因为那真的没有。甚至可以作为If ... Then语句lol:)