こんにちは、Ryoです。
Excelで帳票を作っていれば至る所に「項目」があって、そこに「データ等」が記入されて
いきますが当然ながら複数存在します。
それをVBAで処理する場合、セル位置を全て指定する記述でも問題なく動作はしますが
課題は「セル位置を変えられない」ということになり改訂作業が煩わしいことになります。
そこで今回は指定する文字を対象範囲から検索・抽出してくれる便利な「For Each Next」に
ついて書いてみたいと思います。
もちろん対象は文字だけでは無いので、その辺りもサンプル含めています。
1.構文
For Each [element(要素)] In [group(コレクション)]
[statements(処理)]
ループを抜ける場合・・・[Exit For]
[statements(処理)]
Next[elements(要素)]
For Each Nextステートメントは[group(コレクション)]内の指定する要素に対し
ループ処理を行うものです。
groupは例えば配列やWorkSheet、Range指定範囲等になりますが、ここは実例を見るのが一
一番理解しやすいと思います。
2.サンプルコード
◆例1:全Sheet名の抽出
Sub exsample1()
Dim st As Worksheet
'*****************
'全Sheet名の抽出
'*****************
For Each st In Sheets
Ct = Ct + 1
Cells(ct,1) = st.Name
Next
End Sub
For Eachで指定する要素はヴァリアント型、又はオブジェクトである必要があります。
このサンプルでは全ワークシート名を取得するので「Dim st As Worksheet」を宣言します。
後は構文に従いIn sheets(対象ブックの全シート)に対して、指定した要素である
ワークシートの分繰り返し処理を行いますので、対象を見つけ次第セルに書き込んでいます。
この処理を実行するとセルA1から下へSheet1、Sheet2・・・が書き込まれますので、
良かったらお試しください。
◆例2:全図形/リンクの削除&入力規則除去
Sub exsample2()
Dim ws As Range
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
'//オートシェイプの全除去
shp.Delete
Next
For Each ws In ActiveSheet.UsedRange
'//入力規則を除去
ws.Cells.Validation.Delete
'//ハイパーリンクを除去
ws.Cells.Hyperlinks.Delete
Next
End Sub
先ずオートシェイプの全除去ですが、In ActiveSheet.Shapesと指定することでアクティブな
シートに対してのみ処理を行います。
これはVBA実行ボタン等も含めて全て綺麗さっぱり消してくれて元に戻せませんから使う際は
ご注意を。。。
次に入力規則とハイパーリンク除去(解除)ですが、In ActiveSheet.UsedRangeと指定することでアクティブなシートのセル全域に対して処理を行います。
その中で対象となるValidation(入力規則)、Hyperlinks(ハイパーリンク)を.Deleteとして
消しています。
私はVBA実行ファイルのシートでデータ読み込み等を実行し完了した後、そのシートをコピーして別名を付けて「データファイル」として保存する際に実行ボタンやリンク、入力規則等は
不要になるので、上述の様な処理で消すことに使っています。
残っていても問題は無いのですが、開く度にアラート出たりするのが煩わしいのが理由です。
◆例3:セル上の指定文字列を抽出してセルアドレスを返す
Sub exsample3()
Dim Str_Dat As Variant
For Each Str_Dat In ActiveSheet.UsedRange
Select Case Str_Dat
Case Is = "検索文字A"
Str_Dat.Select
'行列の相対参照
Cells(1, 1) = Str_Dat.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Case Is = "検索文字B"
Str_Dat.Select
'列のみ相対参照
Cells(2, 1) = Str_Dat.Address(RowAbsolute:=True, ColumnAbsolute:=False)
Case Is = "検索文字C"
Str_Dat.Select
'行のみ相対参照
Cells(3, 1) = Str_Dat.Address(RowAbsolute:=False, ColumnAbsolute:=True)
Case Is = "検索文字D"
Str_Dat.Select
'行列の絶対参照
Cells(4, 1) = Str_Dat.Address(RowAbsolute:=True, ColumnAbsolute:=True)
End Select
Next
End Sub
このサンプルではアクティブシート上の適当な位置に”検索文字A”~”検索文字D”の4文字列があるとして、それぞれをFor Eachでループを回しながら見つけた際にセルアドレスを取得してセルA1~A4に書き込むものです。
セルアドレスの取得も4パターンに分けてありますが、私は処理都合上「行列の相対参照」を使うことが多いですね。
この様にFor Eachを使うことで指定する文字列を探し当てることが出来ますから、そこを基準としてデータを取り込む様な処理を記述していけば、列や行の挿入があっても柔軟に対応することが出来ますので後の改訂作業等がすごく楽になります。
以上がFor Each Nextステートメントを使ったサンプルコードと解説になります。
これを使えるとかなり幅が広くなりますから、ぜひ活用いただければと思います。
今回の記事が何かの役に立てれば幸いです。
Ryo

