ワークシート値で配列データを検索する - 特定の値を取得していません

Question

「オフセット」内の数値を変更して、名前と数値を他のシートで必要な場所に移動しようとしましたが、 DavidとAndreaの電話番号は転送されません。

Private Sub CommandButton1_Click() 

Dim ws As Worksheet, bFound As Boolean, rFound As Range 
Dim a As Long, aNames As Variant 

aNames = Array("David", "Andrea", "Caroline") 

With Worksheets("Sheet1").Range("A1:E30").Cells 
       For a = LBound(aNames) To UBound(aNames) 
        Set rFound = .Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False) 
        If Not rFound Is Nothing Then 
         bFound = True 
         Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 5).End(xlUp).Offset(3) = rFound.Value 
         Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 6).End(xlUp).Offset(3, 1) = rFound.Offset(, 1).Value 
        End If 
       Next a 
      End With 
    End 


If Not bFound Then 
    MsgBox "None of the sheets contains the names " & Chr(10) & _ 
     "'" & Join(aNames, "', '") & "' in cells A1:E30.", vbInformation, "Not Found" 
End If 

End Sub 

Answer 1

は、のすべての4行目は最後の空でない1

ながら、その後のWorksheets("Report").Cells(Worksheets("Report").Rows.Count, 6).End(xlUp).Offset(3, 1) ...文の後にその列E最初の空のセルからシートの開始を「報告」の名前を見つけました常に空のセルではなく最初に空のセルが見つかったので、同じセルアドレスを返します。

さらにEndこれは連想させることができないのでステートメントは避けてください未評価

最後に、純粋なコードロジックの観点からは、Worksheets("Sheet1")の代わりにWorksheets("Report")をWithステートメントに入れていたので、すべてのループで前の複数の回をアクセスする必要はありません。while後者はループで一度だけアクセスされ、私は次のように私はコーディングしたいの上にどのようなすべてのための範囲に変数

この後者を設定終わるだろう：

Private Sub CommandButton1_Click() 

    Dim ws As Worksheet 
    Dim bFound As Boolean 
    Dim rFound As Range, rangeToBeSaearchedInRng As Range 
    Dim a As Long, aNames As Variant 

    aNames = Array("David", "Andrea", "Caroline") 

    Set rangeToBeSaearchedInRng = Worksheets("Sheet1").Range("A1:E30") '<--| set your range to be searched in and exploit it inside the loop 
    With Worksheets("Report") '<--| reference "Report" worksheet 
     For a = LBound(aNames) To UBound(aNames) 
      Set rFound = rangeToBeSaearchedInRng.Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False) 
      If Not rFound Is Nothing Then 
       bFound = True 
       With .Cells(.Rows.Count, 5).End(xlUp).Offset(3) '<--| reference referenced worksheet column E first empty cell after last not empty one 
        .Value = rFound.Value '<--| set referenced cell value 
        .Offset(, 1).Value = rFound.Offset(, 1).Value '<--| set the cell value 1 column to the right of referenced cell 
       End With 
      End If 
     Next a 
    End With 


    If Not bFound Then 
     MsgBox "None of the sheets contains the names " & Chr(10) & _ 
      "'" & Join(aNames, "', '") & "' in cells A1:E30.", vbInformation, "Not Found" 
    End If 

End Sub 

Answer 2

End(xlUp)機能と間違って何かがいずれかの論理的または全身的（意味は、おそらくExcelが、それが変わるほど急速に変化し、最後の行を計算することはできません）、があります。この質問への回答が見つかった場合は、電話番号がどこに書かれているかという問題がまだ残っています。だからなぜ試してみる？コードを単純化する（意味を明確にする）方が良いです。例えば、より読みやすいコードを有する

If Not rFound Is Nothing Then 
     bFound = True 
     With Worksheets("Report") 
      R = .Cells(.Rows.Count, 5).End(xlUp).Row + 3 
      .Cells(R, 5).Value = rFound.Value 
      .Cells(R, 6).Value = rFound.Offset(0, 1).Value 
     End With 
    End If 

は、パッシングで、また、それは偽のどこに設定されていないためbFoundのあなたの設定が間違っていることを開示しています。上記のコードの最初の行の前に、次の改正を提案します。あなたの最初のWorksheets("Report").Cells(Worksheets("Report").Rows.Count, 5).End(xlUp).Offset(3) = rFound.Value文が正常に機能しているあなたの目的が配置されている場合

Set rFound = .Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False) 
    bFound = (Not rFound Is Nothing) 
    If bFound Then