VBA Excel VBAでDo Until Loopのネスト、IF文を使って一致するものと一致しない物としたい

Excel VBAでDo Until Loopのネスト、IF文を使って一致するものと一致しない物としたい

sheet1!a2:c5、sheet2!a2:c6を比較して、比較sheet!d2:f8に、一致するする物は
d2:f4、一致しないものはd6:f7と、Do Until loopのネスト、IF文を使って実現したいのですが、
何回やっても、ループが回らず、上手く行きません。大変、お手数ですが、どなたか、ご存じの方、
教えて頂けないでしょうか？office2010のバージョンです。

vba
1Sub test()
2   Dim i As Long, j As Long
3   　With Sheets("sheet1").Range("a1").CurrentRegion.Offset(1, 0)
4       .Resize(.Rows.Count - 1).Copy Sheets("比較").Range("a2") 
5  　　End With
6   
7   Dim Flag As Long
8   Flag = 0
9    
10    i = 2
11  　 Do Until i > Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row
12
13   j = 2
14   　 Do Until j > Sheets("比較").Cells(Rows.Count, "a").End(xlUp).Row
15
16
17      Flag = 0
18         If Sheets("比較").Cells(j, "a") = Sheets("sheet2").Cells(i, "a") Then
19            Sheets("比較").Cells(j, "d") = Sheets("sheet2").Cells(i, "a")
20            Sheets("比較").Cells(j, "e") = Sheets("sheet2").Cells(i, "b")
21            Sheets("比較").Cells(j, "f") = Sheets("sheet2").Cells(i, "c")
22
23          Flag = 1
24          
25         Exit Do
26         
27
28         End If
29      If Flag = 0 Then
30         
31         With Sheets("比較").Range("a1").CurrentRegion
32               .Cells(.Rows.Count + 1, 4) = Sheets("sheet2").Cells(i, "a")
33               .Cells(.Rows.Count + 1, 5) = Sheets("sheet2").Cells(i, "b")
34               .Cells(.Rows.Count + 1, 6) = Sheets("sheet2").Cells(i, "c")
35         End With
36         j = j + 1
37      End If
38         Loop
39      i = i + 1
40      Loop
41End Sub
42
43
44
45
46
47
48
49
50ここに質問の内容を詳しく書いてください。
51
52### 発生している問題・エラーメッセージ
53

エラーメッセージ

試したこと

ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

office2010
ここにより詳細な情報を記載してください。

meg_

2022/12/25 08:00

コードが見にくいのでインデントが分かるように修正お願いします。（どのように投稿されるかはプレビューで確認ください）

meg_

2022/12/25 08:02

> 何回やっても、ループが回らずループに入らないという意味でしょうか？ループ内の処理が一度しか実行されないという意味でしょうか？

kagosimah

2022/12/25 08:06

ループが回り続ける

kagosimah

2022/12/25 08:14

赤枠のようにループが回り続ける。インデントの修正をして、更新しようとしたのですが、更新をクリックしても、何回も更新をクリックしても、更新のクリックが出来ません。すみません。

kagosimah

2022/12/25 08:34

やって、分からないのに、何が丸投げですか?

kagosimah

2022/12/25 08:34

ちょっと、失礼では、有りませんか？

y_waiwai

2022/12/25 08:46

このままではコードが読みづらいので、質問を編集し、</>(コードの挿入)ボタンを押し、出てくる’’’の枠の中にコードを貼り付けてください

meg_

2022/12/25 09:02

> ループが回り続ける。ということは「ループが回らず」ではなく、”無限ループ”の可能性がありますね。コードが読みずらいのでよく分かりませんが、ループ中の i と j の値をデバックで確認されると無限ループの原因が分かるかもしれません。（ループを抜けられないのはループを抜ける条件が成立しないからです） > 何が丸投げですか? 調べたことや試したこと（デバックの結果等）が何も書かれていないからかもしれません。実際には色々調査されているかもしれませんが、第三者にはこの質問文に書かれていることしか知りえませんので。

kagosimah

2022/12/25 09:30

y_waiwaiさん、megさん、すみません。頭に来ていて、やる気が起きません。コードは、コピペして、お手数ですが、インデント、そちらで、かけて下さい。

ak.n

2022/12/25 11:54

ここは初心者の方が質問すると、非常に辛辣な、手厳しい意見が多いと感じます。お互いに切磋琢磨しようという、目的が素晴らしいサイトであるだけに勿体ない。優秀なプログラマは相手に目線合わせをします。相手の説明に不足があれば、何を質問をしたいのかも含めて読み取ろうとします。もちろん、学校の課題等の答えだけを得たいというのは全く感心しませんが、それは相手にしなければよいだけです。相手を突き放すだけの回答者は、結局、相手に目線を合わせられない、能力が低い技術者なのだと思います。気を取り直して頑張ってください。

kagosimah

2022/12/25 12:55 編集

ak,nさん、コメント、ありがとうございます。怒りが収まりました。いい対処法も記述して、下さり、助かりました。気分が楽になりました。

meg_

2022/12/25 13:05

ak.nさんへ > ここは初心者の方が質問すると、非常に辛辣な、手厳しい意見が多いと感じます。他のサイトに比べてそうなんですね。私は他にはStackoverflowぐらいしか見ないのですが、情報が不足している質問等にはなかなか回答が付きづらい印象です。Stackoverflowの場合は質問を回答者が編集できるため勝手が違うところはありますが。答えだけを求める質問には回答は付きづらいですね。

ak.n

2022/12/25 14:16

meg_さんは丁寧に回答しようとされていましたね。初学者の方は、そもそも何の情報を提供すれば良いかがわからない、というところがあるのだと思います。例えばコードを載せることについても、一部分を切り取って載せようとします。他の部分が影響を与えている可能性に思いが至らないためです。質問者と回答者のギャップが、どうしてもありますね。

行動規範の内容に同意します

回答1件

ベストアンサー

不一致データを出力を、内側のDoループ内でしているのが原因ですね。
内側のループ回数分出力されてしまいます。
外側のループ内で出力するようにすればいいでしょう。

vba
1Sub test2()
2    Dim i As Long, j As Long
3    With Sheets("sheet1").Range("a1").CurrentRegion.Offset(1, 0)
4        .Resize(.Rows.Count - 1).Copy Sheets("比較").Range("a2")
5    End With
6
7    Dim Flag As Long
8    Flag = 0
9
10    i = 2
11    Do Until i > Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row
12
13        j = 2
14        Do Until j > Sheets("比較").Cells(Rows.Count, "a").End(xlUp).Row
15            Flag = 0
16            If Sheets("比較").Cells(j, "a") = Sheets("sheet2").Cells(i, "a") Then
17                Sheets("比較").Cells(j, "d") = Sheets("sheet2").Cells(i, "a")
18                Sheets("比較").Cells(j, "e") = Sheets("sheet2").Cells(i, "b")
19                Sheets("比較").Cells(j, "f") = Sheets("sheet2").Cells(i, "c")
20
21                Flag = 1
22                Exit Do
23
24            End If
25            j = j + 1
26        Loop
27        If Flag = 0 Then
28            With Sheets("比較").Range("a1").CurrentRegion
29                .Cells(.Rows.Count + 1, 4) = Sheets("sheet2").Cells(i, "a")
30                .Cells(.Rows.Count + 1, 5) = Sheets("sheet2").Cells(i, "b")
31                .Cells(.Rows.Count + 1, 6) = Sheets("sheet2").Cells(i, "c")
32            End With
33        End If
34        i = i + 1
35    Loop
36End Sub

投稿2022/12/25 12:00

hatena19

総合スコア34352

kagosimah

2022/12/25 12:49

ありがとうございます。無事、自分の思った通りに実装できました。j = j + 1←訂正、24行、Loop　←25行追加、j = j + 1←31行、不要、 Loop←削除、32行とすれば良かったんですね。loopの場所が違ったんですね。また、助けてもらい、大変、助かりました。Total5時間近く、調べて、修整したんですが、全然、分かりませんでした。一つ、お聞きしたくて、ソースコードはどうやったら、色が付くんですか？いつも、分からなくて。