ExcelVBA FindNextを使用して条件に合う重複行を削除したいです

FindNextを使用して条件に合う重複行を削除したいです。しかし以下のコードだと無限ループになってしまってうまくいきません。どうすればいいでしょうか。

Dim i As Long
Dim wb As Workbook
Set wb = ThisWorkbook
Dim Macro_FreeForm As Worksheet 'フリーフォームシート
Set Macro_FreeForm = wb.Sheets("フリーフォーム")
Dim FreeForm_Gyo As Long
Dim FoundCell As Range
Dim firstAddress As String
Dim FreeFrom_Range As Range

FreeForm_Gyo = Macro_FreeForm.Range("A1").CurrentRegion.Item(Macro_FreeForm.Range("A1").CurrentRegion.Count).Row

With Macro_FreeForm

'最終行から上に向かって重複行削除する　行番号がずれるので
For i = FreeForm_Gyo To 3 Step -1

If .Range("S" & i).Value = "値なし" Then
Exit For
End If

'フリーフォームシートの型式列をセット M3～BD列の最終行
Set FreeFrom_Range = .Range(.Cells(3, 13), .Cells(FreeForm_Gyo - 1, 56))

'型式(M列)完全一致で列方向に検索
Set FoundCell = FreeFrom_Range.Find(What:=.Range("M" & i).Value, LookAt:=xlWhole, SearchOrder:=xlByColumns)

If Not FoundCell Is Nothing Then
firstAddress = FoundCell.Address
Do
'以下の条件のとき重複行を削除
If .Range("M" & i).Value = .Cells(FoundCell.Row, "M") And _
.Range("S" & i).Value = .Cells(FoundCell.Row, "S") And _
.Range("BD" & i).Value = .Cells(FoundCell.Row, "BD") Then

.Rows(i).Delete '該当行を削除

FreeForm_Gyo = Macro_FreeForm.Range("A1").CurrentRegion.Item(Macro_FreeForm.Range("A1").CurrentRegion.Count).Row

End If

Set FoundCell = FreeFrom_Range.FindNext(FoundCell)

Loop While Not FoundCell Is Nothing
End If

Next i
End With

No.4 ベストアンサー 回答者： fujillin 回答日時： 2021/10/09 09:34

No2です。

書いた手前もあるので、「別の考え方」のサンプルを作成してみました。

※ 対象範囲の決め方等はご提示のコードに似せたつもりではありますけれど、ご提示のコードが難しいので、見落とし等があるかもしれませんがご容赦。
※ 特に、
　＞If .Range("S" & i).Value = "値なし" Then
の判定が、具体的にどのような意味を持つのかが理解できなかったので、その部分（＝判定）は省いてあります。
　（必要なら、適宜、追加修正などをしてみてください）

結果的に、3行目～最終行までの、M,S,BD列をキーとする重複行が全て削除されます。
（他の列の値が異なるような場合は、行番号の小さな行の方が残されます。）
以下、ご参考にでもなれば。

Sub Sample()
Dim Sht As Worksheet, Rng As Range, LRow As Long
Const SheetName = "フリーフォーム"

Set Sht = ThisWorkbook.Worksheets(SheetName)
LRow = Application.Max(Sht.Cells(1, 1).CurrentRegion.Rows.Count, 3)
Set Rng = Range(Sht.Cells(3, 13), Sht.Cells(LRow, 56))

Rng.RemoveDuplicates Columns:=Array(1, 7, 44), Header:=xlNo
End Sub

この回答へのお礼

ありがとうございます。無事解決しました。

お礼日時：2021/10/12 08:37

No.3 回答者： Qchan1962 回答日時： 2021/10/09 01:35

こんばんは、

ぱっと見でごめんなさい
検索キーの行番号と検索範囲の関係が良く分からないのですが、、なので
原因を回答できないですけれど、、
Set FreeFrom_Range　
rangeオブジェクトは実際のレンジに依存しています。Setの後に対象Rangeオブジェクトをマクロで変更すると変数にSetしている値なども書き変わってしまいます、、

通常？行を削除する場合、最終行から上にループする、と言うのは分かりますが、出来れば、都度、削除実行をせずにまとめて（すべての条件処理が終わってから）処理をする方が処理も早くわかり易いループ処理が出来るのでは無いかと思います。

その部分の例
.Rows(i).Delete '該当行を削除　これをやめて
この部分に

Dim DelRows As Range　’ループ外で

If DelRows Is Nothing Then
Set DelRows = .Range("A" & i)
Else
Set DelRows = Union(DelRows, .Range("A" & i))
End If

最後の
Next i

End With
の間で（Next iが終わったら）

If Not DelRows Is Nothing Then DelRows.EntireRow.Delete


.Rows(i).Delete を無くしてもループが終わらない場合は
For,Do,FindNext 3ループ条件がおかしいと言う事になるのかな、、

あれ？
.Rows(i).Delete？　.Rows(FoundCell.Row).Delete　？
While Not FoundCell Is Nothing？

これって、FoundCell.Row（条件一致行を削除していない時）　i　行を永遠削除続けるのではないかな？　FoundCellの値は、消えないから、、
Doループの必要性、条件などを再検討する必要があるように思いますね　たぶん。。

No.2 回答者： fujillin 回答日時： 2021/10/09 00:42

こんばんは

ちょっと説明がややこしくなってしまいそうですが・・・

ロジック的に、「同じ内容が自分より上の行（＝行番号が小さい行）に存在したら、自分の行を削除する」という内容を行の大きなものからループさせようとしているものと、推測しました。

であるなら、自行を削除したら次の（上の）行の処理に移ればよいのに、
＞Do
　～～
＞Loop While Not FoundCell Is Nothing
で何度も処理する必要はないものと考えられます。

また、FindNextは複数ヒットがある場合には、循環してヒットしますので、（それを識別するために変数firstAddressを用意しているものと思いますが）ご提示のコード全体でも、まったく利用はされていないようです。
（そもそも、不要なループだとは思いますけれど・・・）

一方で、比較する対象は自行よりも上の行のはずですが、検索対象は常に（最初に求めた）FreeForm_Gyo分となるようになっています。（「-1」の演算はしていますけれど、以降かわらないので固定）
ですので、下から2行目より上では必ず自分の行がヒットすることにもなっています。

また、一度行を削除すると、下の行（＝多分空白行）が繰り上がってくるので、検索対象範囲にこの空白行も含まれるようになります。
仮に、空白行が処理対象行になってしまうと、必ずヒットしますし、上記のDOループで何度でもヒットすることになって、抜け出すことがなさそうです。


まったく異なる考え方でも良ければ、もっと簡潔に短いコードにできるのではないかと思います。
・手動操作の場合の、「重複を削除」をM、S、BD列キーにして実行します。
VBAで言えば、
　　Range.RemoveDuplicates
がこれにあたります。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

宣言や範囲選択、その他に若干の行数は必要と思いますが、実質的には上記1行でお求めの内容を実行できるものと思います。
場合によっては、一度、「マクロの記録」をとりながら、上記操作を手動でやってみれば、メソッドの使い方等の雰囲気はわかると思います。

No.1 回答者： mygoonickname 回答日時： 2021/10/08 23:39

こんばんは。

詳しくは見ていませんが、例えば、最初のiで、2つ以上が.Rows(i).Deleteで消える場合はあるのでしょうか？
そうすると、次のiは、何もない空のセルを参照している様な気がします。
空白のM、S、BDは全て空白となると、一生懸命消していたりしないかと。

Debug.Print　i　とかを、Forの下とかに入れて、iがどこまで進んでいるか
確認されるのも良いのでは？と思います。

https://tonari-it.com/excel-vba-debug-print/