|
▼Yoshim さん:
hirofumiさんからYoshimさんのオリジナルコードの骨格を踏まえたコードがでていますが
hirofumiさんも指摘しておられるように処理効率の面で、この構成は課題があるのかもしれません。
で、ちょっと思いついた案です。
同じ場所にフィルターをかけるのは、あまりやったことがなく、いろいろ落とし穴があるかもしれませんが。
Sheet1とSheet2の1行目のタイトルが同じであるとの前提です。
Sub SampleX()
Dim mRow1 As Long, mRow2 As Long
Application.ScreenUpdating = False
With Sheets("Sheet2")
mRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
End With
With Sheets("Sheet1")
mRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A2:A" & mRow1).Interior.ColorIndex = 34
.Range("A1:C" & mRow1).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Sheets("Sheet2").Range("A1:C" & mRow2), Unique:=False
.Range("A2").Resize(mRow1 - 1).Interior.ColorIndex = xlNone
.ShowAllData
End With
Application.ScreenUpdating = True
End Sub
|
|