Excel VBA で二つのシートを比較抽出

質問

Excel VBA で二つのシートを比較して合致するレコードを別のシートに抽出する方法について
下記ホームページのコードを利用させていただきました。
https://okwave.jp/qa/q5917011.html

●fax2シート B列(検索順)
　セル1　A
　　　2　B
　　　3　D
　　　4　C

●fax3シート( 比較抽出結果)
　セル1　A
　　　2　B
　　　3　C
　　　4　D

比較抽出結果が検索順にするにはどのようにコードを記述すればよいか教えていただけますか。

回答No.13

kkkkkm · ベストアンサー

色(書式)のコピーは

変数宣言の後に

Worksheets("Fax3").Cells.Clear

を追加して

'セル幅自動調整
の前に

Worksheets("Fax1").Range("A1").copy
Worksheets("Fax3").Range("A1:Z1").PasteSpecial Paste:=xlPasteFormats
Worksheets("Fax1").Range("A2").copy
Worksheets("Fax3").Range(Cells(2, "A"), Cells(n - 1, "Z")).PasteSpecial Paste:=xlPasteFormats

を追加してみてください。

お礼

セルの色についてもできることが
できました。
いろいろとご教示いただき有り難う
ございました。
コードの記述内容については
今後の為に自分で調べていきます。

回答No.2

kkkkkm

もしかして検索順というのはfax2シートで見つかった順番ではなくfax2シートにある元の順番通りということですか？

回答No.1

kkkkkm

> 比較抽出結果が検索順にするには

もしかしたら抽出部分がFor Eachだからなのかもしれませんので通常のForにしてみて試してみてください。

Dim FoundCell As Range
Dim i As Long

'For Each tempRange In fax1Table.Rows
For i = 1 To fax1Table.Rows.Count
Set FoundCell = fax2Table.Columns(3).Find(fax1Table(i, 1).Value, , xlValues, xlWhole)
If Not FoundCell Is Nothing Then
Set dst = dst.Offset(1)
fax1Table.Offset(i - 1).copy dst
End If
Next i