
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ベストアンサー
- 回答日時:
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
No.3
- 回答日時:
こんばんは、
ぱっと見でごめんなさい
検索キーの行番号と検索範囲の関係が良く分からないのですが、、なので
原因を回答できないですけれど、、
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
- 回答日時:
こんばんは
ちょっと説明がややこしくなってしまいそうですが・・・
ロジック的に、「同じ内容が自分より上の行(=行番号が小さい行)に存在したら、自分の行を削除する」という内容を行の大きなものからループさせようとしているものと、推測しました。
であるなら、自行を削除したら次の(上の)行の処理に移ればよいのに、
>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
- 回答日時:
こんばんは。
詳しくは見ていませんが、例えば、最初のiで、2つ以上が.Rows(i).Deleteで消える場合はあるのでしょうか?
そうすると、次のiは、何もない空のセルを参照している様な気がします。
空白のM、S、BDは全て空白となると、一生懸命消していたりしないかと。
Debug.Print i とかを、Forの下とかに入れて、iがどこまで進んでいるか
確認されるのも良いのでは?と思います。
https://tonari-it.com/excel-vba-debug-print/
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
画面を強制的に再描画させる方法
-
UWSCの終了の仕方
-
VBAでの一時停止と再開の方法
-
DOSコマンドのループ内のTIMEコ...
-
CSVファイルの特定の行だけを読...
-
乱数の桁数指定、または範囲指定。
-
Escキーを押すと、中断する時と...
-
VBA エクセル2010 横長データ...
-
null 参照の例外が実行時に発生...
-
EXCEL VBA ユーザーフォームの...
-
素数の個数を求めるプログラミング
-
For文を使った九九表の作成
-
メビウスループの画像
-
vb.netからエクセル関数書き込み
-
Java 南京錠
-
VB.NETで素因数分解のプログラ...
-
エクセルの当番表を作っていま...
-
アクティブセルから、A列最終行...
-
ループからの抜け出し方
-
システム安定性(ゲイン余裕/...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
画面を強制的に再描画させる方法
-
UWSCの終了の仕方
-
CSVファイルの特定の行だけを読...
-
範囲指定したセルを1つずつ飛...
-
UWSCに制限時間を付けたいです
-
Escキーを押すと、中断する時と...
-
乱数の桁数指定、または範囲指定。
-
VBA for i=1 to lastrow
-
流れ図(フローチャート)が分か...
-
DOSコマンドのループ内のTIMEコ...
-
pythonでファイルのコメント行...
-
素数表について。
-
VBAでの一時停止と再開の方法
-
「偶数・奇数の和」のフローチ...
-
DoEventsが必要な理由について
-
vb.netです。2次元配列の要素を...
-
Do whileでExitせず、ループの...
-
ループフリー
-
エクセルの当番表を作っていま...
-
VBAで3秒だけ時間を止めたい
おすすめ情報