[[20221029122834]] 『二つのリストの複数条件が一致したら転記したい V』(りんご) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『二つのリストの複数条件が一致したら転記したい VBAでやりたい』(りんご)

教えて下さい。マクロで2つのリストを見比べて、条件が一致したらある列を転記したいです。

転記元

 記号	分類	月	転記1	転記2
 A	-	1月	aaa	bbb
 A	a	2月	ccc	ddd
 B	a	5月	eee	fff
 C	a	5月	ggg	hhh
 D	a	2月	iii	jjj
 D	-	2月	kkk	lll
 D	a		mmm	nnn

転記先 (転記1, 転記2の列に、記号・分類・月の条件が元リストと一致したら転記できるようなものを考えたいです)
完成イメージです ↓↓

 記号	分類	月	転記1	転記2
 B	a	5月	eee	fff
 A	-	2月		
 D	a		mmm	nnn
 H	a	2月		

条件には、空白のものもあったりします。
記号 D, 分類 a, 月 空白…のように。転記先も同じパターンだったら転記対象としたいです。

こういった場合、何か良い方法はありますでしょうか?
関数だったら、作業列で&で組み合わせて、検索キーとして、
「=IFERROR(VLOOKUP(O2,A:F,5,FALSE),"")」のように引っ張れるかなと思うのですが、
マクロでやるとどのようにやるのか、まだ不慣れで苦戦しています。

例えば、マクロでも同じように検索キーを作って、
matchで突合せるとかでしょうか。出来れば作業列は増やしたくないのですが、一発でやる良い方法はありますか?

< 使用 Excel:Office365、使用 OS:Windows10 >


msgbox evaluate("IFERROR(VLOOKUP(O2,A:F,5,FALSE),"""")")
(What) 2022/10/29(土) 13:10:55

 こんにちは!
方法は色々あると思いますが、何かと紐付けするのは案外ディクショナリーが簡単だったりします。
ちょっと端折って書いてますけど、、一応こんな感じになります。

    |[A] |[B] |[C]|[D]  |[E]  |[F]|[G] |[H] |[I]|[J]  |[K]  
 [1]|記号|分類|月 |転記1|転記2|   |記号|分類|月 |転記1|転記2
 [2]| A  |-   |1月|aaa  |bbb  |   | B  |a   |5月|eee  |fff  
 [3]| A  |a   |2月|ccc  |ddd  |   | A  |-   |2月|     |     
 [4]| B  |a   |5月|eee  |fff  |   | D  |a   |   |mmm  |nnn  
 [5]| C  |a   |5月|ggg  |hhh  |   | H  |a   |2月|     |     
 [6]| D  |a   |2月|iii  |jjj  |   |    |    |   |     |     
 [7]| D  |-   |2月|kkk  |lll  |   |    |    |   |     |     
 [8]| D  |a   |   |mmm  |nnn  |   |    |    |   |     |     

 参考にしてもらえたら幸いです。

 では、、では、、また

 Option Explicit
Sub kkk()
Dim MyDic As Object
Dim v As Variant
Dim x As Variant
Dim i As Long
Set MyDic = CreateObject("Scripting.Dictionary")
v = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 5)
For i = LBound(v, 1) To UBound(v, 1)
    MyDic(v(i, 1) & "," & v(i, 2) & "," & v(i, 3)) = Array(v(i, 4), v(i, 5))
Next
x = Range("G1", Range("G" & Rows.Count).End(xlUp)).Resize(, 3)
ReDim Preserve x(LBound(x, 1) To UBound(x, 1), LBound(x, 2) To 5)
For i = LBound(x, 1) To UBound(x, 1)
    If MyDic.Exists(x(i, 1) & "," & x(i, 2) & "," & x(i, 3)) Then
        x(i, 4) = MyDic(x(i, 1) & "," & x(i, 2) & "," & x(i, 3))(0)
        x(i, 5) = MyDic(x(i, 1) & "," & x(i, 2) & "," & x(i, 3))(1)
    End If
Next
Range("G1").Resize(UBound(x, 1), UBound(x, 2)).Value = x
End Sub
(SoulMan) 2022/10/29(土) 16:20:15

SoulMan様
ありがとうございます!!
Dictionaryも配列も、参考になるコードが色々あり、とても勉強になります。
そして、やりたい事も一瞬で再現できました。
まだ完全に理解出来ていませんが、
Dictionaryの使い方を別途勉強してから一つずつ読み解いてみたいと思います。
大変ありがとうございました。

(りんご) 2022/10/29(土) 16:50:20


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.