マクロでマスタ表からフィルタ表と同じデータ抽出

質問

仕事で不定期ですが月に４～５回マスタ表が届きます。

その表から私の担当している部品のみ抽出するフィルタ表があり
素人ながら簡単な録画マクロで処理を行っています。
（マスタ表から抽出フィルタを使いフィルタオプションで抽出して新しいシートに出力）

但し、毎回マスタ表の最終セルの座標をマクロの編集で記載してから実行しており何とか自動で最終セルを認識してくれないかと色々調べましたが思うように動いてくれません。

マスタ表は毎データ行数列数はバラバラですが部品番号などの位置はフォーマットとして共通です。約１８０００行で列は８行～２３行
抽出用の担当フィルタは私が担当している部品で約５００点ほどで不定期メンテナンスしており増減します。

本来であれば現在のマクロのソースを記載したいのですが会社にファイルがあるので一旦書き込みだけいたします。

回答No.4

Prome_Lin

回答No.3です。

範囲指定した方が、精神衛生上、良い、という方のために。

Option Explicit
Sub Test()
Dim s1, s2, s3 As Worksheet
Dim f As Object
Dim i, r As Long
Set s1 = Worksheets(1)
Set s2 = Worksheets(2)
Set s3 = Worksheets(3)
r = s1.Range("A1").End(xlDown).Row
For i = 2 To s2.Range("A1").End(xlDown).Row
Set f = s1.Range("A1:A" & r).Find(s2.Cells(i, 1).Value)
s1.Range("A" & f.Row & ":E" & f.Row).Copy s3.Range("A" & i)
Next i
End Sub

特別、説明は必要ないと思います。

前提条件等は、すべて「回答No.2」と同じです。

回答No.3

Prome_Lin

極めて単純なマクロの考え方です。

参考になれば、使ってください。

前提条件は、左端のシートが「マスタ」、左から２番目が「フィルタ」（「部品番号」のみ）、左から３番目が「抽出結果」です。

「Ａ」列が部品番号で、部品番号を検索して処理しています。

Option Explicit
Sub Test()
Dim s1, s2, s3 As Worksheet
Dim f As Object
Dim i As Long
Set s1 = Worksheets(1)
Set s2 = Worksheets(2)
Set s3 = Worksheets(3)
For i = 2 To s2.Range("A1").End(xlDown).Row
Set f = s1.Range("A:A").Find(s2.Cells(i, 1).Value)
s1.Rows(f.Row).Copy s3.Range("A" & i)
Next i
End Sub

マクロの説明です。

Set s1 = Worksheets(1)
Set s2 = Worksheets(2)
Set s3 = Worksheets(3)

それぞれのシートを、左端から「s1」、「s2」、「s3」にセットしています。

For i = 2 To s2.Range("A1").End(xlDown).Row

２番目のシート（「フィルタ」）の「Ａ」列の最終行を取得しています（途中空白なしを前提）。

Set f = s1.Range("A:A").Find(s2.Cells(i, 1).Value)

１番目のシート（「マスタ」）の「Ａ」列すべてを範囲指定して、２番目のシートの「部品番号」を１つずつ、「マスタ」シートから検索します。

s1.Rows(f.Row).Copy s3.Range("A" & i)

検索によって得られた行（「f.Row」に何行目にその部品番号があったか入っています）の１行をコピー（記憶）し、３番目のシート（「抽出結果」）にペーストしています。

このマクロの場合、最終行の取得は、「フィルタ」のみ行っています。

よく、「Find」の「Range」指定で、正確に範囲指定されておられるのをよく見受けますが、「Ａ」列全体を範囲指定も、処理時間に差はありません。

このマクロの最大の問題は、「Find」によって、見つからないときの処理がないことです。

あくまで、「フィルタ」にある「部品番号」は、必ず「マスタ」にも存在する、ということを前提条件としています。

回答No.2

ushi2015

こんにちは
元データのシート名が「照合表マスタ」として
数式タブの名前に定義で「マスタ」という名前で、範囲に
=INDIRECT("照合表マスタ!$A$1:$E"&COUNTA(INDIRECT("照合表マスタ!$A:$A")))
と設定して保存し、記録したフィルタのデータ範囲を
　 Range("マスタ").AdvancedFilter Action:=xlFilterCopy, ～
のように変更してみて下さい。

回答No.1

okwtun

最終セルを知りたい場合、
最終行のセルを　MaxRow
最終列のセルを　MaxCol
とすると

' 行や列に抜けが無い場合は先頭から調べていけばわかります。
' 上から順に空白セルまで調査
MaxRow = Range("A1").End(xlDown).Row
MaxCol = Range("A1").End(xlToRight).Column
'
' 行や列に抜けがある場合は最終から調べていけばわかります。
' 下から順に空白セルまで調査
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
MaxCol = Cells(1, Columns.Count).End(xlToLeft).Column