VBAで全体のブックを検索し、結果を別のワークシートに貼り付けます。

Question

最初に、クレジットが期限切れのクレジットカードを提示します。これはMr.Excel.comとexceltip.comのu/Joe Wasのコードを使ってまとめられています。

私は、検索ボックスに入力された値を見つけるために、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 

Answer 1

は、これを試してみてください。私は最初のセクションをどのように解釈したのか再検討しました。私はあなたがすべてで何をしようとしているかを完全には分かっていないので、もしこれがうまくいくか、それが間違っていたかを教えてください。

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 :)