vbaエクセルマクロについて RemoveDuplicatesを使わずに、重複行を削除すらマクロを作

Question

vbaエクセルマクロについて

RemoveDuplicatesを使わずに、重複行を削除すらマクロを作りたいです。

次のような処理をしたいです。

RemoveDuplicatesメソッドだと

WorkSheet（1）.Range("A:Z").RemoveDuplicates Columns:=Array（1, 3）,Header:=xlYes

このようになります。

この処理をRemoveDuplicatesを使わずに、他のメソッドでマクロを作る方法はありますか？

河内のおやじ · Accepted Answer

Sub RemoveDuplicateRows()
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim rowToDelete As Boolean
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row ' データが入力されている最終行を取得
    
    For i = lastRow To 2 Step -1 ' 最終行から順に各行をチェック
        rowToDelete = False ' 初期値は削除しない
        
        For j = i - 1 To 1 Step -1 ' 以前の行と比較
            If Cells(i, "A").Value = Cells(j, "A").Value And _
               Cells(i, "B").Value = Cells(j, "B").Value Then ' 重複がある場合
                rowToDelete = True ' 削除フラグをセット
                Exit For ' 以前の行との比較を終了
            End If
        Next j
        
        If rowToDelete Then Rows(i).Delete ' 削除フラグがセットされていれば、行を削除
    Next i
    
    Range("A1:B" & lastRow).Select ' 更新されたセル範囲を選択
End Sub

このマクロでは、各行を順にループして、以前に出現したことがあるかどうかをチェックしています。もし重複がある場合は、削除フラグをセットして、最後に削除します。最後に、更新されたセル範囲を選択します。

注意: このマクロを実行する前に、必ずバックアップを作成してください。また、データを編集する前に、マクロの動作を確認するためにサンプルデータで試してください。

Qchan1962 · Answer

こんばんは
どのような事でRemoveDuplicatesメソッドがダメなのか分かりませんけれどRemoveDuplicatesメソッドは大変高速に処理が出来るメソッドだと思いますので
少し汎用性を加味して少しでも早い処理をと考えた　例です

Sub example_01()　'実行プロシージャ
'WorkSheet1.Range("A:Z").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes
Dim c As Variant
Dim c1 As Long, c2 As Long
c1 = 1: c2 = 26 'A=1 Z=26
For Each c In Array(1, 3)
Call myRemoveDuplicates(Worksheets(1), c1, c2, CLng(c), 2)
Next
End Sub

Sub myRemoveDuplicates(sht As Worksheet, c1 As Long, c2 As Long, colm As Long, n As Integer)
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Dim rng As Range
Dim i As Long
With sht
For i = n To .Cells(Rows.Count, colm).End(xlUp).Row
    If Not Dic.Exists(.Cells(i, colm).Value) Then
        Dic.Add (.Cells(i, colm).Value), 0
    Else
        If rng Is Nothing Then
            Set rng = .Cells(i, c1)
        Else
            Set rng = Union(rng, .Cells(i, c1))
        End If
    End If
Next
End With
 '.EntireRow
If Not rng Is Nothing Then rng.Resize(, c2).Delete Shift:=xlUp
Set Dic = Nothing
Set rng = Nothing
End Sub

Deleteを書いていますのでコピーファイルなどで試してください
引数を変更して
Delete Shift:=xlUpをSelectに変更してブレークポイントを設定すると
対象範囲が理解できるかも知れません
また、.Cells(i, colm).Value　を.Textなどで試す必要があるかも知れません

河内のおやじ · Answer

重複行を削除するマクロを作成するには、次の手順を実行する必要があります。

データが入力されているセル範囲を選択します。
重複した行を削除するために、各行をループして、その行が以前に出現したことがあるかどうかをチェックします。
以前に出現したことがある場合は、その行を削除します。
ループが終了したら、更新されたセル範囲を選択します。
以下は、この手順を実行するVBAマクロの例です。例として、データがA列からB列にある場合を想定しています。必要に応じて、範囲を変更してください。

vbaエクセルマクロについて RemoveDuplicatesを使わずに、重複行を削除すらマクロを作

Sub RemoveDuplicateRows()

こんばんは

重複行を削除するマクロを作成するには、次の手順を実行する必要があります。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング