.find、.findnext変数でマルチレンジを選択してください。

Question

下記のコードで苦労しています。それは***に完全に痛みです。私は本当に助けが必要です。 このコードは、サマリーとリストを除くすべてのワークシートから条件を検索する検索ツールです。 .Findが単語を見つけた後、コードは検索された単語の周りに4つのワイドレンジを選択し、それをコピーして要約シートに貼り付けます。 最初に検索された単語が見つかった場合、検索結果のすぐ後にある実際のワークシート（単語が見つかる場所）のタイトル（各ワークシート「G3：J3」）を要約ページにコピーして貼り付けたいと思います。この検索ツールを使用すると、どの検索条件をどこで見つけることができ、どのシートでどのタイトルを見つけることができます。

結果は次のようになります

項目NR（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 

私はcopy文を見つけましたが、むしろ、クリップボードを使用してより良いオプションだった、私はまたfirstAddressの不足している参照を発見しました。