| |
▼たけちゃんまん さん
コードの解説（といってもそんなにたいそうなコードではないのですが）は以下の通りですが
その前に、是非、エクセルの強力な機能であるオートフィルターやフィルターオプションを
シート上の操作で体験して、その便利さを実感してください。
オートフィルターについてはおそらく、経験があるとは思いますが、「オートフィルター」
あるいは「フィルターオプション」で検索して、出てくるページの中でわかりやすいものを参考に
実際にやってみてください。
いずれも、処理効率も、ゴリゴリコードを書いて処理するより、格段に優れています。
フィルターオプションはオートフィルターに比べて、与える条件も細かに設定できますし
また、その場所でフィルタリングの他にフィルタリング結果を別の場所に抽出ということも
その標準機能の中で実現可能で、優れものです。
ただ、条件の設定がちょっと煩雑（？）で、最初は敬遠されがちかも。
いずれにしても、これら操作をマクロ記録しますと、私がアップしたコードが生成されます。
なお、オートフィルターでxl2007以降限定と書きましたが、オートフィルター自体は古くからある機能。
ただ、xl2003までは、抽出対象を２つまでしか与えられなかったのですが、xl2007以降、必要なだけ
与えることができるようになっています。
'フィルターオプション
Application.ScreenUpdating = False
'処理中の画面の動きを隠します。画面のちらつきを抑止するとともに、
'セル書き込み時の処理効率をアップさせる効果があります。
Set shT = Sheets("Sheet2") '転記シート
'コード内で何度か参照しますので、短めの名前の変数に代入して
'以降は shT を使います。コードが見やすくなる効果があります。
shT.UsedRange.ClearContents
'UsedRange は、そのシートで使用されている領域を矩形で表したアドレス領域。
'これから、そのシートに転記するので、その前に、クリアしておきます。
With Sheets("Sheet1") '元シート
'↑で shT に代入するコードがありましたが、もう１つ、オブジェクトを With でくくって
'以下、End With までの間でそのオブジェクトを参照する場合、.そのオブジェクト という
'記述ができます。これも、コードを見やすく、すっきりさせる効果があります。
cols = .UsedRange.Columns.Count
'UsedRange は使用領域。Sheet1 は A列 から始まっていますので、その列数が転記列数になります。
Set r = .Range("A1", .UsedRange).Offset(1)
'Sheet1 のタイトル行は２行目です。わかりにくいかもしれませんが
'.Range("A1", .UsedRange) は、２行目から始まるリストの領域に１行目を加えた領域になります。
'で、.Offset(1) は、それを１行下に移動させたところ、つまりリスト領域に、その下の空白行を
'加えた領域になります。本来、この空白行は不要ですが面倒なので、リスト領域に含めています。
'１行目が完全に空白行であれば .UsedRange.Offset(1) でいいのですが、そこが不明でしたので
'あえて このような書き方にしました。
.Cells(1, cols + 2).Value = .Range("I2").Value '抽出項目タイトル
'フィルターオプションに与える抽出条件項目名を、リスト領域の外につくります。
.Cells(2, cols + 2).Resize(3).Value = WorksheetFunction.Transpose(Array("'=b001", "'=b002", "'=b003"))
'その下、２行目以降に抽出文字列を３つセットしています。たんに b001 といった文字列にしますと
'b001 からはじまるものすべてが対象になりますので = を付けて完全一致条件にしています。
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Cells(1, cols + 2).CurrentRegion, _
CopyToRange:=shT.Range("A1"), Unique:=False
'この１行がフィルターオプション実行コードです。抽出結果を SHeet2のA1から始まる領域に転記します。
.Cells(1, cols + 2).CurrentRegion.Clear
'処理後、リスト領域の外側に作った条件欄をクリアします。
shT.Select
'処理結果が目で見れるように最後に Sheet2をアクティブにします。
'オートフィルター
★フィルターオプションで説明したコードについては割愛します。
.AutoFilterMode = False
'念のため、オートフィルターモードを解除します。
r.AutoFilter Field:=9, Criteria1:=Array("b001", "b002", "b003"), Operator:=xlFilterValues
'この１行で、リストのI列に指定の文字列があるものをフィルタリングします。
If r.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then r.Copy shT.Range("A1")
'抽出があった場合、タイトル行以外にデータ行がありますので、その状態かどうかを判定し
'抽出されていれば、オートフィルター領域を Sheet2の A1から始まる場所にコピペします。
'ここが、オートフィルターの「ミソ」なんですが、抽出されたものだけがコピペ対象になります。
.AutoFilterMode = False
'処理後、オートフィルターモードを解除します。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
