VBA if文 複数条件

Question

Sub Test()
Dim ws1 As Worksheet, ws2 As Worksheet, myDate1
Dim List, cnt As Long, i As Long, j As Long 
Set ws1 = Worksheets("リストA")
Set ws2 = Worksheets("リストB") 
myDate1 = ws2.Range("B2")

If Not (IsDate(myDate1)) Then Exit Sub
List = ws1.Range("A1").CurrentRegion
cnt = UBound(List, 1) + 1 

For i = 2 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
For j = UBound(List, 1) To 2 Step -1 　’リストの下から探すため（一番新しいデータ）

’リストBの品番で検索し、ヒットしたら
If ws2.Cells(i, 2).Value = List(j, 2) Then
’ヒットした行をコピぺ※ここで、一番新しいデータだけでなく、過去分までコピペされている
ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)

If ws1.Cells(j, 4).Value = "B" Then
ws1.Cells(cnt, 4).Value = "A"
End If

ws1.Cells(cnt, 3).Value = myDate1 

'☆箇所の条件を追加してみました
’リストBの品番がヒットしなければ、リストBの品番2で検索
ElseIf ws2.Cells(i, 3).Value = List(j, 2) Then
’ヒットした行をコピペ
ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)

If ws1.Cells(j, 4).Value = "B" Then
ws1.Cells(cnt, 4).Value = "A"
End If

cnt = cnt + 1
Exit For
End If
Next j
Next i 
End Sub 
```以前、質問した内容で、編集の必要が出てきました。
要件に応じて修正しているのですが、うまくいかない部分があり※☆箇所、ご教授頂けないでしょうか。

下記リストがあります。
リストBの品番をリストAの品番の下から検索しヒットした行をコピーして（つまり最新行）、リストAの最終行に貼りつける。このとき、貼りつけ先行の登録日はリストBセルB2の登録日（固定）に書き換え、貼りつけ先の区分がBであればAに更新する。
☆上記に追加で、もしB列の品番でヒットしない場合は、C列の品番2で検索をかける。
この場合、貼付け先の登録日は何もしない。それ以外はB列品番で検索した時と同じ作業をする。

リストA
商品名/品番/登録日/区分
aaa/001/yyyymmdd/A
iii/002/yyyymmdd/A
uuu/003/yyyymmdd/C
iii/002/yyyymmdd/A
aaa/001/yyyymmdd/B
uuu/003/yyyymmdd/A
・
・
aaa/001/yyyymmdd/B 
リストB
商品名/品番/品番2/登録日
aaa/001/100/yyyymmdd
iii/002/200/yyyymmdd
uuu/003/300/yyyymmdd
・
・
・ 

うまくいかないこと
マクロは動くのですが、対象外の行もコピぺされてしまいます。
B列で検索をかけ、ヒットしなければC列で検索をかける。
B列で検索をかけた場合と、C列で検索をかけた場合で異なる処理をする場合は
どのように設定すればよいでしょうか。

Comments

[meg_]

1行ずつデバッグすると何が原因か判明するかと思います。「対象外の行もコピぺされてしま」うときの変数の値を確認すると良いでしょう。

[退会済みユーザー]

アドバイスいただき、１行ずつ実行してみたのですが、If ws2.Cells(i, 2).Value = List(j, 2) Then
ws1.Rows(j).Copy Destination:=ws1.Rows(cnt) この部分で、リストAの下から検索して最初にヒットした行のみをコピーしたいのですが、過去分も全てコピぺされています。
if文を組み込む場所が悪いようで何度もループされているようです。
いろいろ場所を変えたりしているのですが、うまくできません。
どこを修正すればよいか教えて頂けないでしょうか。

[meg_]

今のままではコードがとても読みにくいので、「コードの挿入」で記入してください。

[退会済みユーザー]

読みにくく申し訳ございません。コードの挿入に記入してみました。

[meg_]

コードを掲載するときはインデントをつけてください。インデントがなくても動作する言語もあるかと思いますが人がコードを読む際には必須です。今後ご注意ください。

[mattuwan]

登録日の列の値(表示されている文字ではない）は、ちゃんと日付なんでしょうか？
例示だと、文字列と読めます。
文字列なら、過去かどうかの判定に間違いがでるかも？
というか、最新の登録日だけを得られればいいのでしょうか？
それとも、リストBにないリストAのデータをコピーしたいのでしょうか？
伏字で例を書かれても、ルールを読み取れません。
こうなっているときに、こうなって欲しいという、ビフォー&アフターを
提示してみてはいかがでしょうか？

Answer 1

机上デバッグしてみました。Excelでの動作確認はしていませんのでバグがありましたら修正してください。
ポイントはヒットしたかどうかをチェックするフラグを追加したことと、リストBの品番でリストAを全部検索してから品番2で検索することです。

Sub Test()
  Dim ws1 As Worksheet, ws2 As Worksheet, myDate1
  Dim List, cnt As Long, i As Long, j As Long
  Dim copyCheck As Boolean

  Set ws1 = Worksheets("リストA")
  Set ws2 = Worksheets("リストB")
  myDate1 = ws2.Range("B2")

  If Not (IsDate(myDate1)) Then Exit Sub
    List = ws1.Range("A1").CurrentRegion
    cnt = UBound(List, 1) + 1

    For i = 2 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
      copyCheck = False
      For j = UBound(List, 1) To 2 Step -1   'リストの下から探すため（一番新しいデータ）
        If copyCheck = False Then
          'リストBの品番で検索し、ヒットしたら
          If ws2.Cells(i, 2).Value = List(j, 2) Then
            'ヒットした行をコピぺ※ここで、一番新しいデータだけでなく、過去分までコピペされている
            ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)
            copyCheck = True
             
            If ws1.Cells(j, 4).Value = "B" Then
              ws1.Cells(cnt, 4).Value = "A"
            End If

            ws1.Cells(cnt, 3).Value = myDate1
            cnt = cnt + 1
           End If
        End If
      Next j
 
      If copyCheck = False Then
        For j = UBound(List, 1) To 2 Step -1   'リストの下から探すため（一番新しいデータ）
          If copyCheck = False Then
            'リストBの品番がヒットしなければ、リストBの品番2で検索
            If ws2.Cells(i, 3).Value = List(j, 2) Then
              'ヒットした行をコピペ
              ws1.Rows(j).Copy Destination:=ws1.Rows(cnt)

              If ws1.Cells(j, 4).Value = "B" Then
                ws1.Cells(cnt, 4).Value = "A"
              End If
              copyCheck = True
              cnt = cnt + 1
            End If
          End If
        Next j
      End If

    Next i
End Sub 

Comments

[退会済みユーザー]

有難うございます。実行したところ、Nextに対応するForがありませんと出てしまいます。
私には難しく、Exit Forを（cnt=cnt+1の後ろ？）どこに入れたらよいのか...大変恐縮なのですが宜しくお願いします。

[meg_]

修正しました。とりあえずコンパイルエラーは出ないはずです。

[退会済みユーザー]

ありがとうございます。うまく動かないので、いろいろ試してみます。ご教授いただいたポイントと一緒にコードを解読してみようと思います。できましたらコメントいたします。
宜しくお願いします。

[meg_]

動作確認しました。いくつかおかしなところがあったので修正しました。

[退会済みユーザー]

やりたいことができました。
ご教授頂いたポイントをコードで照らし合わせて勉強しました。有難うございました。