VBA セルの検索と条件分岐による転記

Question

前提・実現したいこと

現在、VBAにてexcel業務を効率化出来る様に、勉強をし始めました。
恥ずかしながら、制御構文を使いこなせてない為、アドバイスを頂きたいと考えています。よろしくお願いします。![![f341c36f32e969a535337b14c85d87cd.jpeg)

sheet2のセルC2値に対して、sheet1のB4〜B列最終行まで検索を行い、以下条件を処理を行う。
・完全合致した場合は、sheet1のB4〜B列の該当セルへ上書きを実施。
・合致しない場合は、sheet1のB4〜B列の最終入力済セルの次行（空白）へ転記。

発生している問題・エラーメッセージ

該当のソースコード

Sub 検索転記()
Dim number As Range     '入力値
Dim result As Range     '検索結果
Dim lastline As Long    '最終行
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
Set number = ws2.Range("C2")

lastline = ws1.Cells(Rows.Count, "B").End(xlUp).Row

For i = 4 To lastline
Set result = ws1.Range("B" & i).Find(number, lookat:=xlWhole)

If result Is Nothing Then 'Rangeが「Nothing」である場合
   n = Cells(Rows.Count, "B").End(xlUp).Row + 1
   ws1.Range("B" & n).Value = number.Value

ElseIf Not result Is Nothing Then
   ws1.Range("B" & i).Value = number.Value

End If

Next i

End Sub

試したこと

if、for文にて作成したのですが、合致しない場合への情報分岐と合致した場合の上書きがどのようなロジックを立てて作成したらよいか分からない為、アドバイスをいただきたいです。

Comments

[yureighost]

今のコードを実行して、自分で何が問題だとかの疑問はありましたか？
そういったことを書いてくださると回答しやすいです。

[jabe]

連絡ありがとうございます。
自分の中では、該当セルが無い場合にif文にてどのよに分岐をしていけばよいのかロジックが分からず、そこが問題だと思っています。

Answer 1

把握しておられるかわかりませんが、Excelのシートの例に貼られてる画像の状態で、
現在の処理で動作させると、No欄に大量の1が書き込まれてしまいます。
これはFor文で行数分検索チェックしているからで、そこが根本的に勘違いされてるところだと思います。
Find関数は複数のセルを範囲指定して検索できますのでそれを使います。
多分これでご要望にある動作はできてると思います。
修正した部分にはコメントを入れさせてもらいましたので確認してみてください。

Sub 検索転記()
    Dim number As Range     '入力値
    Dim result As Range     '検索結果
    Dim lastline As Long    '最終行
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Set ws1 = Worksheets("sheet1")
    Set ws2 = Worksheets("sheet2")
    Set number = ws2.Range("C2")
    
    lastline = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    
    'No列の開始行から最終行の範囲で検索する
    Set result = ws1.Range(ws1.Cells(4, 2), ws1.Cells(lastline, 2)).Find(number, lookat:=xlWhole)
    
    'For文は不要
    
    If result Is Nothing Then 'Rangeが「Nothing」である場合
       n = Cells(Rows.Count, "B").End(xlUp).Row + 1
       ws1.Range("B" & n).Value = number.Value
    
    ElseIf Not result Is Nothing Then
        'Findの結果で取得されたRangeから行数を取得し、その行に書き込む
        ws1.Cells(result.Row, 2).Value = number.Value
    
    End If
End Sub

Comments

[jabe]

早速の連絡とコードありがとうございます。
実現したい内容通りに動作できました。

はい、大量の1が書き込まれていました。
アドバイスの通り、Find関数の考え方が誤っていました。
また、コード自体（rangeではなく、cellsを使用しているところも）も分かりやすく勉強になりました。