エクセル２つの列にある値の完全一致を抜き出すVBA

Question

お世話になります。

エクセルでデータを貼り付けしたときに、
A列とB列の完全一致データを行ごと（AからMまで）別のシートに摘出したいと思っております。
また一致したデータは削除せずに全て摘出したいと考えております。

膨大なデータ数ですので処理に時間はかかると思っておりますが、
VBAで自動で処理できる方法をご教示頂けないでしょうか。

ご指導を宜しくお願いいたします。

めぐみん_ · Answer

・貼り付ける前はどのような所にあるデータなのでしょうか？
・『A列とB列の完全一致データ』とはＡ列の値とＢ列の値が同じ場合との解釈で宜しいのでしょうか？
・『膨大な』とは１００万行とか？（Excelの最大行数は、1,048,576 行）
それとも１～５万行程度？

tatsumaru77 · Answer

レイアウト等の確認です。
１．添付図のようなレイアウトであってますか。
（１行目が見出しで、データは２行目から）
２．添付図の場合は、３行と５行が摘出対象となる。
３．膨大なデータということですが、およそ何行ありますか。

めぐみん_ · Answer

No.1です。

＞『A列とB列の完全一致データ』とはＡ列の値とＢ列の値が同じ場合との解釈

についたしますがＡ：Ｂの比較する組み合わせ語句？は、単一でしょうか複数行ありますでしょうか？

めぐみん_ · Answer

No.3　です。

＞についたしますが

追加しますの間違いでした。

あと

＞膨大なデータ数ですので処理に時間はかかると思っておりますが

何か作業をやってみて時間がかかるので改善案と言う事でしょうか？
それともまだやってなく手の憶測ですか？
まぁデータ数次第ですがPowerQueryって機能もあるようですしね。
⇒元のデータがどこにあるのかにもよりそう。

fujillin · Answer

こんにちは

こんな感じでしょうか？
※ 不明点は勝手に想定。

Sub Q_13270809()
Dim ws As Worksheet
Set ws = ActiveSheet
With Worksheets.Add(after:=ws)
ws.Range("A:M").Copy .Range("B1")
.Range("B1").CurrentRegion.Columns(1).Offset(, -1).FormulaLocal = "=IF(B1=C1,"""",1)"
If Application.Max(.Columns(1)) > 0 Then _
.Columns(1).SpecialCells(xlCellTypeFormulas, xlNumbers).EntireRow.Delete
.Columns(1).Delete
End With
End Sub

fujillin · Answer

No5です。

10000行でテストしたけれど、1秒もかからないですよ。
（マシンの性能も影響すると思いますが・・・）

tatsumaru77 · Answer

補足要求です。
①見出しは1行目で、データは２行目からでしょうか。
②シート１のシート名は何でしょうか。(Sheet1で良いですか）
③シート２のシート名は何でしょうか。(Sheet2で良いですか）

Qchan1962 · Answer

こんばんは
出力の位置関係はどうします？ソートしますか（元データ順）・・
それとも2つ目が出てきた順で良いですか・・
ソートする　例見出しは考慮していません　新規ブックで操作されます
処理速度はデモデータが無いので未確認

Sub Example01()
ActiveSheet.Copy
Dim dic As Object
Set dic = CreateObject("Scripting.dictionary")
Dim arData As Variant
Dim ary()
Dim i As Long, j As Long
Dim v As String
Dim Rng As Range
arData = Range(Cells(1, "A"), Cells(Rows.Count, "M").End(xlUp)).Value
For i = 1 To UBound(arData)
    v = arData(i, 1) & arData(i, 2)
    If Not dic.Exists(v) Then
        dic.Add v, 0
    Else
        If dic.Item(v) = 0 Then
            ReDim Preserve ary(j)
            ary(j) = v
            j = j + 1
        End If
        dic.Item(v) = dic.Item(v) + 1
    End If
Next
Set dic = Nothing
Dim k, dupData()
Dim n As Long, x As Long
For j = 0 To UBound(ary)
    For i = 1 To UBound(arData)
        v = arData(i, 1) & arData(i, 2)
        If StrComp(v, ary(j)) = 0 Then
            For x = 1 To UBound(arData, 2)
                ReDim Preserve dupData(UBound(arData, 2), n)
                dupData(0, n) = i
                dupData(x, n) = arData(i, x)
            Next
            n = n + 1
        End If
    Next i
Next
Range("A1").CurrentRegion.ClearContents
Range("A1").Resize(UBound(dupData, 2) + 1, UBound(dupData, 1) + 1).Value = WorksheetFunction.Transpose(dupData)
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns(1).Delete
End Sub

Qchan1962 · Answer

#8です
Macエクセルですか・・・
残念です
CreateObject("Scripting.dictionary")が使えません
StrCompも使えるか分かりません
一応、　https://qiita.com/r_keir/items/6f03a753bbd32dc8cce7
で対策し添削する必要があるようです

ローカル環境にMacエクセルが無い為、代替え手法が上手くいくか、
処理速度などの確認も出来ない為、これ以上の回答は出来そうもありません

Qchan1962 · Answer

一応
処理時間は分かりません・・未検証

Sub Example02()
Application.ScreenUpdating = False
ActiveSheet.Copy
Dim arData As Variant
Dim i As Long
Dim v()
Dim Rng As Range
arData = Range(Cells(1, "A"), Cells(Rows.Count, "M").End(xlUp)).Value
ReDim v(1 To UBound(arData))
For i = 1 To UBound(arData)
    v(i) = arData(i, 1) & arData(i, 2)
Next
Cells(1, "N").Resize(UBound(v)) = WorksheetFunction.Transpose(v)
For i = 1 To UBound(v)
    If Application.CountIf(Range(Cells(1, "N"), Cells(Rows.Count, "N").End(xlUp)), v(i)) <= 1 Then
        If Rng Is Nothing Then
            Set Rng = Cells(i, 1)
        Else
            Set Rng = Union(Rng, Cells(i, 1))
        End If
    End If
Next
Rng.EntireRow.Delete
Columns("N:N").Delete
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

エクセル ２つの列にある値の完全一致を抜き出すVBA

・貼り付ける前はどのような所にあるデータなのでしょうか？

レイアウト等の確認です。

No.1です。

No.3 です。

こんにちは

No5です。

補足要求です。

こんばんは

#8です

一応

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

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

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

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

エクセル２つの列にある値の完全一致を抜き出すVBA

No.3　です。