| 
    
     |  | 質問3.はおいておいて、 
 質問1.と質問2.に関してだけですが、
 
 (簡単のため、結合セルはなくて、1行1データの構成であったと
 仮定しますと)
 要は
 
 「データ」シート
 A   B   C  D  E  F  G
 aaa  1/1 あああ a-1 0   0  0
 aaa  2/1 あああ a-2 0   0  0
 bbb  2/3 いいい b-1 1000 0  0
 bbb  5/3 いいい b-2 3000 0  0
 ccc  5/2 ううう c-1 900  0  0
 ccc  8/2 ううう c-2 1200  0  0
 ddd  6/4 えええ d-4 100  200 300
 
 「表」シート
 A列  B列 C列  … O列  P列  Q列  R列
 aaa
 bbb
 ccc
 eee
 
 とあったら、
 Find転記後「表」シートは ↓のようになっていればいいって
 ことなんですよね?
 
 「表」シート
 A列  B列 C列  … O列  P列  Q列 R列  S列 T列 …
 aaa    1/1 あああ a-1 0   0  0
 aaa    2/1 あああ a-2 0   0  0
 bbb    2/3 いいい b-1 1000 0  0
 bbb    5/3 いいい b-2 3000 0  0
 ccc    5/2 ううう c-1 900  0  0
 ccc    8/2 ううう c-2 1200 0  0
 
 だったら「表」シートのC列の(元のユニークな)抽出データは
 配列に覚えておいて、「データ」シートの該当行を<転記先行>の
 O列〜AH列に転記するとき、同時に検索値もC列に<転記先行>に
 上書きしてしまえば、いいのでは?
 
 Sub マッチング2()
 Dim 検索範囲 As Range, 該当セル As Range
 Dim FirstHitRow As Long
 Dim 転記先行 As Long '最初にヒットした行番号
 Dim tbl As Variant, v As Variant
 
 With Worksheets("データ") '「検索範囲」は A列
 Set 検索範囲 = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
 End With
 
 転記先行 = 5 '「転記先行」はO列 5行目から
 With Worksheets("表").Range("C5:C55")
 tbl = .Value 'C列 抽出データ
 .ClearContents
 End With
 For Each v In tbl
 If Not IsEmpty(v) Then
 Set 該当セル = 検索範囲.Find(v, , xlFormulas, xlWhole)
 If Not 該当セル Is Nothing Then '該当セルが見つかった場合は
 FirstHitRow = 該当セル.Row '最初にヒットした行番号
 Do
 該当セル.Copy Cells(転記先行, 3) 'C列に上書き
 CopyLine 該当セル, Cells(転記先行, 15) '21列をコピー
 
 転記先行 = 転記先行 + 2 '転記先行に2を加算する。
 
 Set 該当セル = 検索範囲.FindNext(該当セル) '次を検索
 
 Loop While 該当セル.Row <> FirstHitRow
 End If
 End If
 
 Next
 
 End Sub
 
 
 |  |