Ａ列Ｂ列どちらにもあるのを抽出する

いつもお世話になっております
下記のコードは
Ａ列にあってＢ列にないものをＤ列に
Ｂ列にあってＡ列にないものをＣ列に
のコードを以前いただきました。

Ａ列Ｂ列どちらにもあるのを抽出する
にはどうしたよろしいでしょうか

わかる方おしえてくれませんでしょうか

Sub x()
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")

Dim i As Long, i2 As Long

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Key = Cells(i, 1).Value
Dic(Key) = i
Next i

i2 = 2
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
Key = Cells(i, 2).Value


If Dic.exists(Key) = True Then
Dic.Remove (Key)
Else
Cells(i2, 3).Value = Key
i2 = i2 + 1
End If
Next

i = 2
For Each Key In Dic.keys
Cells(i, 4).Value = Key
Next Key



End Sub

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/12/06 08:40

新しく作り直しました。

Public Sub Y()
Dim dicT1 As Object
Dim dicT2 As Object
Dim key As Variant
Dim wrow As Long
Dim wrow2 As Long
Range("C2:E" & Rows.Count).ClearContents
Set dicT1 = CreateObject("Scripting.Dictionary")
Set dicT2 = CreateObject("Scripting.Dictionary")
For wrow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
key = Cells(wrow, 1).Value
dicT1(key) = True
Next
For wrow = 2 To Cells(Rows.Count, 2).End(xlUp).Row
key = Cells(wrow, 2).Value
dicT2(key) = True
Next
wrow = 2
wrow2 = 2
For Each key In dicT1.keys
If dicT2.exists(key) = True Then
Cells(wrow, 5).Value = key
wrow = wrow + 1
Else
Cells(wrow2, 4).Value = key
wrow2 = wrow2 + 1
End If
Next
wrow2 = 2
For Each key In dicT2.keys
If dicT1.exists(key) = False Then
Cells(wrow2, 3).Value = key
wrow2 = wrow2 + 1
End If
Next
End Sub

この回答へのお礼

すばらしいです
ありがとうございました。

お礼日時：2023/12/06 09:10

No.7 回答者： 初心者ですが何か。 回答日時： 2023/12/13 09:20

No.5です。

少し改訂したものです。

Sub md_2()
Dim myDic As Object
Dim m As Integer, v As Variant, key
Dim r As Range

Application.ScreenUpdating = False

Set myDic = CreateObject("Scripting.Dictionary")

Range("A2", Cells(Rows.Count, "A").End(xlUp)).Name = "あ1"
Range("B2", Cells(Rows.Count, "B").End(xlUp)).Name = "あ2"

For m = 1 To 2
For Each r In Range("あ" & m).Cells

If Not myDic.Exists(r.Value) Then

ReDim v(0 To 2)

If WorksheetFunction.CountIf(Range("あ" & CStr(3 - m)), r.Value) > 0 Then
v(2 - m) = "": v(2) = r.Value
Else
v(2 - m) = r.Value: v(2) = ""
End If

myDic.Add r.Value, v

End If
Next
Next

With Range("C2").Resize(myDic.Count, 3)
.Value = Application.Transpose(Application.Transpose(myDic.Items))
.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)
End With

Application.ScreenUpdating = True

End Sub

でも以前ＡＤＯをされてたようでしたがSQL文で挑戦するのも良いかもですよ。
私は挫折しましたけど。

No.6 回答者： 初心者ですが何か。 回答日時： 2023/12/12 16:39

No.5です。

テスト画像忘れてました。

No.5 回答者： 初心者ですが何か。 回答日時： 2023/12/12 16:07

既に解決済みでご覧になられてないかもですが。

DictionaryオブジェクトのItemには配列も格納できるのでこのような方法も。

Sub md()
Dim myDic As Object
Dim m As Integer, v(2) As Variant, key
Dim r As Range

Application.ScreenUpdating = False

Set myDic = CreateObject("Scripting.Dictionary")

Range("A2", Cells(Rows.Count, "A").End(xlUp)).Name = "あ1"
Range("B2", Cells(Rows.Count, "B").End(xlUp)).Name = "あ2"

For m = 1 To 2
For Each r In Range("あ" & m).Cells

If Not myDic.Exists(r.Value) Then

v(0) = "": v(1) = "": v(2) = ""

With WorksheetFunction

Select Case True

Case .CountIf(Range("あ" & CStr(3 - m)), r.Value) > 0
v(2 - m) = "": v(2) = r.Value

Case .CountIf(Range("あ" & CStr(3 - m)), r.Value) = 0
v(2 - m) = r.Value: v(2) = ""

End Select

End With

myDic.Add r.Value, v

End If
Next
Next

With Range("C2").Resize(myDic.Count, 3)
.Value = Application.Transpose(Application.Transpose(myDic.Items))
.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)
End With

Application.ScreenUpdating = True

End Sub

初心者ちょいのレベルなので可読不可能な点にはご容赦を。

No.4 回答者： 高木さんWIN 回答日時： 2023/12/06 18:27

例えばＡ列を順に取得しワークシート関数のCountIfで検索範囲をＢ列全て検索値をＡ列の値で０を超えた時、順次希望の列に書き出しつつそこの行番号カウントを増やす。

ではダメなのでしょうか？
Dictionaryオブジェクトの勉強って事なら何ですが、手段に拘らないならと思いました。
逆をしたい時は検索と検索値を逆にする。
行番号のカウント変数を初期値にする。
とか？

No.2 回答者： fujillin 回答日時： 2023/12/05 22:44

こんばんは

スピル機能が使える環境を想定しても良いのなら・・

E1セル等に
=UNIQUE(FILTER(B1:B100,COUNTIF(A:A,B1:B100)>0,""))
のような関数式を入力すれば、お求めの結果が得られます。

※ 式中の「100」の部分は、B列の最大行数以上の数にしておく必要があります。
※ マクロで行いたければ、上記の式をE1セル等に設定するマクロでできます。
（結果を固定値にしたければ、E列をコピー、値をペーストで固定値化できます）

この回答へのお礼

ありがとうございます
参考にします。

お礼日時：2023/12/05 23:36

No.1 回答者： tatsumaru77 回答日時： 2023/12/05 22:30

>Ａ列Ｂ列どちらにもあるのを抽出する

>にはどうしたよろしいでしょうか

Ａ列Ｂ列どちらにもあるのをどの列に出力したいのでしょうか。

この回答へのお礼

早速ありがとうございます
Ｅ列でお願いいたします。

お礼日時：2023/12/05 22:32