【VBA】IF文がうまくいかない

Question

したいこと
別ブックの"YYY（２）"シートと、"YYY"シートを照らし合わせて
G, H, I, J, K, M列の値が全て等しい場合、
"YYY（２）"シートのB列を、"YYY"シートのB列に転記したい。

解決したいこと
下記、コードだと正答率が半分程度になってしまいます。
どこが原因か分からず、お知恵をお貸しください。

下記、コードの表示

        '別ブックを開く
        Workbooks.Open Filename:=ThisWorkbook.Path & "\XXX.xlsm"
        
        Set Wb1 = ThisWorkbook 'このブック
        Set Wb2 = Workbooks("XXX") '別ブック
        
        Set Sht1 = Wb1.Worksheets("YYY")
        Set Sht4 = Wb2.Worksheets("YYY（２）")
      
        'フィルタを解除する
        Dim ws As Worksheet

        row1 = 2
        For y = 2 To Sht1.Cells(Rows.Count, 6).End(xlUp).Row
        For z = 2 To Sht4.Cells(Rows.Count, 6).End(xlUp).Row

            If Sht1.Cells(y, 7).Value = Sht4.Cells(z, 7).Value And _
                    Sht1.Cells(y, 8).Value = Sht4.Cells(z, 8).Value And _
                        Sht1.Cells(y, 9).Value = Sht4.Cells(z, 9).Value And _
                            Sht1.Cells(y, 10).Value = Sht4.Cells(z, 10).Value And _
                                Sht1.Cells(y, 11).Value = Sht4.Cells(z, 11).Value And _
                                    Sht1.Cells(y, 13).Value = Sht4.Cells(z, 13).Value Then
                Sht1.Cells(row1, "B").Value = Sht4.Cells(z, "B").Value
                row1 = row1 + 1
            End If
        Next
    Next
   
            Wb2.Close

Comments

[bebebe_]

FOR文の終了条件がF列の最終行になってますがそこは問題ないですか？

[HOKO]

ご確認ありがとうございます。
そちらは問題ございません。

上記を実行するとなぜかG, H, I, J ,K, M列すべてが異なる行のB列が転記されてしまい、
困っております。。

[HOKO]

正しく転記される行と、されない行があり、さらに困惑してしまいます。。

[Usirow]

すべて異なる行が転記されてしまうのは、yとzの二重ループのせいで、まったく関係ない行同士もすべて比較しているのが原因かなと思いましたが、その場合は転記されない行が出てくるのが謎ですね。

[bebebe_]

異なる行がコピーされる原因にはならないと思いますがコードの中のフィルターの解除の部分は機能してますか？
手間にはなってしまいがコード編集のところでF8を押して1行ずつ実行していくと原因がわかりそうな気がします。

Answer 1

Option Explicit
Sub Sample()
    Dim Wb2 As Workbook, Sht1 As Worksheet, Sht4 As Worksheet
    '別ブックを開く
    Set Wb2 = Workbooks.Open(Filename:=ThisWorkbook.Path & "\XXX.xlsm")
    Set Sht1 = ThisWorkbook.Worksheets("YYY")
    Set Sht4 = Wb2.Worksheets("YYY（２）")
    Dim Y As Long, Z As Long
    For Y = 2 To Sht1.Cells(Rows.Count, 6).End(xlUp).Row
        For Z = 2 To Sht4.Cells(Rows.Count, 6).End(xlUp).Row
            If Sht1.Cells(Y, 7).Value = Sht4.Cells(Z, 7).Value And _
                    Sht1.Cells(Y, 8).Value = Sht4.Cells(Z, 8).Value And _
                    Sht1.Cells(Y, 9).Value = Sht4.Cells(Z, 9).Value And _
                    Sht1.Cells(Y, 10).Value = Sht4.Cells(Z, 10).Value And _
                    Sht1.Cells(Y, 11).Value = Sht4.Cells(Z, 11).Value And _
                    Sht1.Cells(Y, 13).Value = Sht4.Cells(Z, 13).Value Then
                Sht1.Cells(Y, "B").Value = Sht4.Cells(Z, "B").Value
                Exit For
            End If
        Next
    Next
    Wb2.Close
End Sub

Comments

[HOKO]

ご回答ありがとうございます。
他にコードを色々書いていたので、省いていたのですが、変数定義はしております。。

試しにいただいたコードでも試してみましたがうまくいかないのです。。

[yorozuya]

別に、変数宣言が無いことを論ったつもりはありません。

ただうまくいかないと言われても、こちらでは判断できません。

何も変更せずに、回答した内容を試行してみてください。

どこがどううまくないのですか？

[HOKO]

いただいたコードをそのまま実行しましたが、
正しくG, H, I, J, K, M列が全て等しい"YYY（２）"シートのB列を、"YYY"シートのB列に転記する行と、
転記しない行があります。

正しく転記できない行は、G, H, I, J, K, M列すべて等しくないです。

うまく転記できる行と、そうでない行があるので原因がわからず困っています。

[yorozuya]

「そうでない行」というのは
(1) 転記されない
(2) 誤った値が転記される
どちらですか？

[HOKO]

分かりづらく申し訳ございません。(2)です。

[yorozuya]

問題の切り分けの為に、下記を試してもらえますか？

Option Explicit
Sub Sample()
Dim Wb2 As Workbook, Sht1 As Worksheet, Sht4 As Worksheet
Application.EnableEvents = False
'別ブックを開く
＜以下同文＞