Excel VBAで、重複カットする処理を作りたい

Excel VBAで、重複カットする処理を作りたいです。以下仕様にて作成したいと思っているのですが、どのようなVBAにすればよいかを教えてください。 ＜やりたいこと＞ ・添付画像をご参照ください。前提として、F列：項目6で重複が発生し、その重複は、J列：項目10で、1,2のいずれかの値での重複となります（それ以外の重複ケースは存在しない） ・項目10で値が1の分を残し、値が2の方を重複カットしたい。 ＜具体的なアウトプットイメージ＞ ・添付画像の通りです。 よろしくお願いいたします。

No.2 ベストアンサー 回答者： MayTyu 回答日時： 2021/08/01 12:38

添付の画像の通りの表で、下に無限に続くものを想定して組んであります。

処理速度を重視しているので順番が処理後に順番が変わるかと思いますが、マクロのなかにもともとのデータ並び順に直すようなものを入れると元に戻るかと思います。

Sub Test()
Dim maxRow As Long
maxRow = Cells(Rows.Count, 6).End(xlUp).Row
'Arrange in ascending order in column J
Call Range("A1:K" & maxRow).Sort(Range("J2"), , , , , , , xlYes)
'Delete duplicate data
Range("A1:K" & maxRow).RemoveDuplicates (Array(6))
'Depending on the situation, write the code here to arrange them in the original way.
End Sub

この回答へのお礼

ご丁寧にありがとうございました。よくわかりました。

お礼日時：2021/08/01 19:51

No.1 回答者： fujillin 回答日時： 2021/08/01 12:13

こんにちは

説明がよくわかりませんけれど、要は
「J列2行目以降で値が2となっているセルの行全体を削除したい」ってことと解釈しました。

こんな感じでしょうか？
（以下はセル選択で終了しています。削除にするにはSelectをDeleteに変更してください。）

Sub Sample_Q12490536()
Dim rg As Range, rw As Long

For rw = 2 To Cells(Rows.Count, 10).End(xlUp).Row
If Cells(rw, 10).Value = 2 Then
If rg Is Nothing Then Set rg = Cells(rw, 10) Else Set rg = Union(rg, Cells(rw, 10))
End If
Next rw

If Not rg Is Nothing Then rg.EntireRow.Select '←削除ならDeleteに変更

End Sub