いつもお世話になっております
下記のコードは
A列にあってB列にないものをD列に
B列にあってA列にないものをC列に
のコードを以前いただきました。
A列B列どちらにもあるのを抽出する
にはどうしたよろしいでしょうか
わかる方おしえてくれませんでしょうか
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ベストアンサー
- 回答日時:
新しく作り直しました。
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
No.7
- 回答日時:
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
でも以前ADOをされてたようでしたがSQL文で挑戦するのも良いかもですよ。
私は挫折しましたけど。
No.5
- 回答日時:
既に解決済みでご覧になられてないかもですが。
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
- 回答日時:
例えばA列を順に取得しワークシート関数のCountIfで検索範囲をB列全て検索値をA列の値で0を超えた時、順次希望の列に書き出しつつそこの行番号カウントを増やす。
ではダメなのでしょうか?
Dictionaryオブジェクトの勉強って事なら何ですが、手段に拘らないならと思いました。
逆をしたい時は検索と検索値を逆にする。
行番号のカウント変数を初期値にする。
とか?
No.2
- 回答日時:
こんばんは
スピル機能が使える環境を想定しても良いのなら・・
E1セル等に
=UNIQUE(FILTER(B1:B100,COUNTIF(A:A,B1:B100)>0,""))
のような関数式を入力すれば、お求めの結果が得られます。
※ 式中の「100」の部分は、B列の最大行数以上の数にしておく必要があります。
※ マクロで行いたければ、上記の式をE1セル等に設定するマクロでできます。
(結果を固定値にしたければ、E列をコピー、値をペーストで固定値化できます)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 超難 日付に対するクロス集計 7 2021/12/06 20:56
- Excel(エクセル) VBA Scripting.Dictionary 連想配列 複数参照する方法 2 2021/12/17 01:52
- Visual Basic(VBA) リストボックス複数選択抽出方法 6 2023/10/18 17:40
- Visual Basic(VBA) 離れたセルを比較 5 2022/02/02 19:59
- Visual Basic(VBA) 連想配列について 1 2021/12/15 19:41
- Visual Basic(VBA) Excel VBA キーワードから列を取得して、さらに空欄行を非表示にする 3 2022/10/21 22:49
- Visual Basic(VBA) VBA countif について 3 2021/12/16 20:13
- Visual Basic(VBA) Excel VBAでフォルダ内の全テキストファイルの任意データを取得について 7 2021/12/18 16:00
- Visual Basic(VBA) 条件をつけてカウントする 4 2021/12/19 20:27
- Visual Basic(VBA) 条件をつけて 抽出 7 2021/12/14 14:37
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
ご教授お願いします。#NUM!が解消されません。
Visual Basic(VBA)
-
excelのVBAについて、以下のコードに追加をお願いいたします。
Visual Basic(VBA)
-
Excelセルに入力された文字の色を変える方法を教えてください
Visual Basic(VBA)
-
-
4
VBAのコードを教えてください
Visual Basic(VBA)
-
5
VBEを開くのにコマンド名が「Visual Basic」な理由はなぜ?
Visual Basic(VBA)
-
6
Excel VBAでの数値の計算についておしえてください
Visual Basic(VBA)
-
7
特定文字を入ってるCSVの特定の列を特定のexcelシートに取り込みたいです
Visual Basic(VBA)
-
8
Excel VBA コードを教えてください。
Visual Basic(VBA)
-
9
VBA コード
Visual Basic(VBA)
-
10
for 文の 繰り返し処理に使えるのかどうかについて
Visual Basic(VBA)
-
11
エクセル VBAでの転記の方法について
Visual Basic(VBA)
-
12
VBAを教えていただきたいです。 添付のような「data sheet」があります。 他に、「集計 s
Visual Basic(VBA)
-
13
Excel VBAマクロをマスターするのに、どれ位時間掛かりますか?
Visual Basic(VBA)
-
14
VBA 二つのブックをうまく扱えないでいます
Visual Basic(VBA)
-
15
Excel VBA ダブルクリックで入力 複数まとめる
Visual Basic(VBA)
-
16
VBAのことで質問です
Visual Basic(VBA)
-
17
ExcelのVBAのことで質問です。 以下のコードを入れ、ボタンを押せば作動させると写真のように画面
Visual Basic(VBA)
-
18
VBAコードが作動しません。修正したいのですが何処に原因かあるか教えて下さい。
Visual Basic(VBA)
-
19
コードを直していただきたいです。 以下のコードはネットで拾ったものをほんの少しいじった物なのですが、
Visual Basic(VBA)
-
20
Cellsのコードが打てません
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
VBAのFind関数で結合セルを検索...
-
複数処理 Worksheet_Change(ByV...
-
B列の最終行までA列をオート...
-
IIF関数の使い方
-
VBAで、特定の文字より後を削除...
-
VBAを使って検索したセルをコピ...
-
エクセル 2つの表の並べ替え
-
Changeイベントでの複数セルの...
-
データグリッドビューの一番最...
-
VBAで、離れた複数の列に対して...
-
VBA UserFormからの転記で
-
マクロ 最終列をコピーして最終...
-
VBA 列が空白なら別のマクロへ...
-
複数の列の値を結合して別の列...
-
VBマクロ 色の付いたセルを...
-
VBAの構文 3列置きにコピーし...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
B列の最終行までA列をオート...
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
VBAを使って検索したセルをコピ...
-
文字列の結合を空白行まで実行
-
VBA指定行削除
-
VBAのFind関数で結合セルを検索...
-
IIF関数の使い方
-
VBA 何かしら文字が入っていたら
-
マクロ 最終列をコピーして最終...
-
エクセルについて
-
【VBA】2つのシートの値を比較...
-
URLのリンク切れをマクロを使っ...
-
データグリッドビューの一番最...
-
Changeイベントでの複数セルの...
-
空白セルをとばして転記
-
rowsとcolsの意味
-
エクセルVBAにて =A1=B1とすれ...
おすすめ情報