文字列のカッコで括られた部分だけを狙い撃ちで削除するマクロ
セル内のカッコで括られた文字列のみ削除する
都道府県番号の一覧表
ひょんなことで、都道府県番号の一覧表が欲しいなあと思ってggってみたら、
こんな一覧ばっかり（画像はWikipediaのものです）で、表形式のまま取り込めるものがなかなか見つからなかった。
やっとのことで、
こんなページを見つけて、Excelの表に貼り付けたんだが、
カッコの中の読み仮名がジャマ!!!!!!!!
なんですよねー。
まあ、しょせん47都道府県のことだから、手作業でやっても大して時間はかからないわけなんですが、マクロでやりましたよ。
カッコで括られた部分のみ削除するマクロ
今回は、次のような感じで組み立ててみました。
処理の流れ
- 文字列の文字数を取得して文字数分ループ
- 文字列の先頭から１文字づつ調べる
- 開始カッコのところまでは順に連結
- 開始カッコのところに来たら削除フラグOn
削除フラグがOnの間は文字を連結しない - 終了カッコのところまで来たら削除フラグOff
削除フラグOffの間は文字を連結する - できあがった文字列をセルに返す
これを、For Each ～ In Selectionで回す、というちょい書きマクロ。
リスト1-1
まずは、メインのコード。
Sub deleteContents()
Dim objCell As Range
Dim objStr As String
For Each objCell In Selection '……(1)'
objStr = objCell.Value '……(2)'
objCell.Value = _
deleteContentsEnclosedByBracket _
(objStr, "(", ")") '……(3)'
Next
End Sub
コードの説明
(1)の
For Each objCell In Selection '処理の内容 Next
は、選択範囲の各セルに処理を施すというやつで、今回のようなちょい書きマクロでは非常によく使う方式（って、私だけ……？）。
処理を施す範囲を柔軟に設定できるので、重宝している。
(2)の
objStr = objCell.Value
では、一旦変数にセルの中身をセット。
んで、(3)では、自作のdeleteContentsEnclosedByBracket関数（ってか、長ぇ名前だな、オイ！）に文字列を渡して「カッコでくくった文字列を削除する」処理をさせている。
別に、この程度の処理なので外に括り出すまでもなかったかも知れないけれど、もしかしたらあとあと拡張できるかもしれないと思ったので、今回もYAGNYの原則に反する対応をとってしまった……orz
まあ、Forループがネストするのはできれば避けたいというのもある。
リスト1-2
コチラは、呼び出されるdeleteContentsEnclosedByBracket関数のコード。
Private Function deleteContentsEnclosedByBracket _
(ByVal objStr As String, _
ByVal startBracket As String, _
ByVal endBracket As String) As String '……(1)'
Dim enableToDelete As Boolean '……(2)'
Dim tmp As String
Dim chr As String
Dim i As Integer
For i = 1 To Len(objStr) '……(3)'
chr = Mid(objStr, i, 1) '……(4)'
If chr = startBracket Then '……(5)'
enableToDelete = True
End If
If chr = endBracket Then '……(6)'
enableToDelete = False
chr = "" '……(*)'
End If
If enableToDelete = False Then '……(7)'
tmp = tmp & chr
End If
If enableToDelete = True Then '……(8)'
End If
Next
deleteContentsEnclosedByBracket = tmp '……(9)'
End Function
リスト1-2の説明
まず、(1)。
Private Function deleteContentsEnclosedByBracket _
(ByVal objStr As String, _
ByVal startBracket As String, _
ByVal endBracket As String) As String
第１引数のobjStrが、処理対象の文字列。
第２引数のstartBracketは、開始カッコ。
第３引数のendBracketは、終了カッコ。
引数名がやたら長いのはいつものことなんですが、意味の取れる引数名にしようとするとどうしてもこうなっちゃうんですよねー。
要するに、第１引数で渡された文字列に対して、第２・３引数で渡された文字で括られた文字列を削除して返す、という処理をするわけです。
当然、第２引数や第３引数に２文字以上の文字列を渡されたら困るわけですが、ちょい書きなので……。
(2)からの４行
Dim enableToDelete As Boolean Dim tmp As String Dim chr As String Dim i As Integer
は変数の宣言。いちおう、
- enableToDelete……削除可能フラグ
- tmp……一時的に文字列を入れておく
- chr……処理対象文字列から取り出した１文字を入れておく
- i……Forループ用のカウンタ
といったところ。
(3)では、
For i = 1 To Len(objStr) '処理の内容 Next
の形で受け取った文字列の文字数分ループ処理を行う。Len関数は、
Len（文字列）
の形で文字列の文字数を返してくれる。
(4)では、
chr = Mid(objStr, i, 1)
Mid関数を用いて、objStrで渡した文字列の中からi番目の1文字を変数chrにセットしている。
Mid関数は、
Mid(文字列,開始位置,切り出したい文字数)
の形で、文字列の[開始位置]番目から[切り出したい文字数]文字分の文字列を返してくれる。
んで、(5)と(6)では、
If chr = startBracket Then enableToDelete = True End If If chr = endBracket Then enableToDelete = False chr = "" '……(*) End If
切り出した１文字が開始カッコまたは終了カッコかどうかを判定して、削除可能フラグのOn / Offを切り替えるようにしている。Elseを使えば行数を減らせるのは分かっていますが、最近は極力Elseを使わないようにしているので。
ちなみに、(*)を忘れると、けったいな結果になるので注意。当たり前ですが。
(7)の
If enableToDelete = False Then tmp = tmp & chr End If
は、削除可能フラグがOffの場合の処理。普通に切り出した１文字を追加しているだけ。
(8)の
If enableToDelete = True Then End If
は、別にいらないんだけど、あえて書いている。削除可能フラグOnのときは何もしない、ということ。
削除可能フラグOnの間に出てくる文字列は削除対象なので、追加しない、という形で削除を実現。
で、(9)。
deleteContentsEnclosedByBracket = tmp
Forループを抜けたということは、全文字に対する処理が終わったということだから、できあがった文字列tmpを呼び出し元に戻り値として返してやる。
実行結果
範囲を選択して実行すると、
ほれ。カッコで括られていた文字列が消えた。
おわりに
こういうちょっとした処理がサクサクっと書けるようになると、Excelを使った作業系の仕事は激速になると思う。
脱・初心者のために(1)
私が脱・初心者を自覚した瞬間
……といっても、ある瞬間にスイッチが入ったように「今日を以て初心者を卒業します。私のことを嫌いになっても、初心者のことは嫌いにならないでください！」とか思ったわけではない。
何度も何度も、それはもう何度も何度も、Time After Time……ですよ。「ぼちぼち初心者の域はだっしたかなー」、「いやいや、こんなことも分かっていないようじゃあまだまだだな……」というのを何度も繰り返して今に至るわけです。
今回は、そのたくさんある瞬間のうちの一つ、ということでご理解ください。
「値渡し」と「参照渡し」
コレ、最初何のことだかサッパリ分からなかった。
たいていの本には、
「値渡し」は、変数のコピーを呼び出した側のプロシージャに渡します。
「参照渡し」はその変数への参照を呼び出した側のプロシージャに渡します。
とかいうようなことが書いてある。
これ、最初全然意味が分からなかった。「ByVal」と「ByRef」を使い分けると何がうれしいのか分からなかったんだな。
で、たいていの本には、「とりあえず引数を受け取る側ではByValつけときゃいい」みたいな投げやりなアドバイスが載っていたりする。まあ、それでたいてい問題はないし、「ByVal」で渡せない引数（オブジェクト系）だとコンパイルエラーが出て実行させてもらえないから、「とりあえずByVal」で行けてしまう。
でもねえ……。
プログラミングというのは論理的思考の権化みたいなもんなんだから、そこを「おまじない」みたいな理解でごまかすのは良くないと思う。
で、どうすんの？
使い分けることで何がうれしいのか、については私もよく分かっていないが、「値渡し」と「参照渡し」がどう違うのか、というのはちゃんと理解しておいた方が良いと思う。
そもそも、「引数」ってのはよく料理やなんかの「材料」にたとえられる。メソッドとかプロシージャが「調理」という処理で、「調理」に必要な「材料」が「引数」というわけだ。
「引数」というもののイメージをつかむにはこれで問題ないと思うんだが、その理解しかないと、「値渡し」だの「参照渡し」だのといったときにつまづくもとだと思う。
「値渡し」と「参照渡し」の違い
「処理の材料」という意味では、値渡しにしようが参照渡しにしようがどっちでもいい。ただ、渡し方というか、「渡す」ということの意味が違う。
変数hogeに、「ち～んｗ」という文字列が入っているとしよう。
VBAのコードだと、
Dim hoge As String hoge = "ち～んｗ"
こういう状態だな。
で、この「ち～んｗ」という文字列を「値渡し」にする場合と「参照渡し」にする場合とで何が違うのか、ということだ。
結論から述べる。渡しているものが違う。見た目は同じでも。
へ？？？ どういうこと？
次のコードを実行したら、どうなるだろうか。
リスト１
Sub hogeCaller() Dim hoge As String hoge = "ち～んｗ" Call hogeCalledByVal(hoge) Call hogeCalledByRef(hoge) End Sub Sub hogeCalledByVal(ByVal str As String) MsgBox str End Sub Sub hogeCalledByRef(ByRef str As String) MsgBox str End Sub
リスト１の実行結果
まずはこいつが表示され、[OK]をクリックしたら、
こいつが表示される。
１回目のメッセージボックスと、２回目のメッセージボックスは、全く同じものに見えるし、実際同じものだ。
しかし、１回目の「ち～んｗ」と２回目の「ち～んｗ」の意味合いはまるで違う。
だから、何が違うのさ？
まず、hogeCalledByValに渡された「ち～んｗ」。こいつは、
純粋な文字列としての「ち～んｗ」
だ。
一方、hogeCalledByRefに渡されたのは、
ただの文字列「ち～んｗ」ではない
ということだ。
じゃあ、何なのか。hogeCalledByRefに渡されたのは、
変数hogeの中身としての「ち～んｗ」
ということだ。
といっても、(ﾟДﾟ)ﾊｧ? だろう。もうちょっと説明する。
「値渡し」の場合、渡された時点で「ち～んｗ」という文字列には、もはや「変数hogeの中身」という意味合いはない。「純粋な文字列」と言ったのはそういうことだ。
それに対して、「参照渡し」の場合は、文字列を渡しているのではない。ざっくり言うと、
変数hogeが使っているメモリの番地を教えている
のだ。
たとえば、変数hogeがメモリの１丁目１番地に値を保持しているとしたら、この場合「ち～んｗ」という文字列がメモリの１丁目１番地に保存されていることになる。
変数hogeを「参照渡し」にするということは、
そっちの処理で材料がいるって言うからくれてやるぜ！
ほれ！ 中身が知りたきゃメモリの１丁目１番地にあるから好きに使いな！
という感じだ。
リスト１の場合、変数hogeの中身は「ち～んｗ」だから、確かに「ち～んｗ」を渡しているように見えるし、その通りなんだが、「参照渡し」の場合は、どこまでも
変数hogeの中身としての「ち～んｗ」
ということだ。
だから、参照渡しにした場合、渡した先で引数を加工すると、当然変数hogeの中身そのものが加工されることになる。
で、何なの？
たとえば、リスト１を次のように書き換えてみる。
リスト２
Sub hogeCaller() Dim hoge As String hoge = "ち～んｗ" '……(1) Call hogeCalledByRef(hoge) '……(2) MsgBox hoge '……(6) End Sub Sub hogeCalledByRef(ByRef str As String) MsgBox str '……(3) str = "(ﾟДﾟ)ﾊｧ?" '……(4) MsgBox str '……(5) End Sub
こいつを実行するとどうなるか。
リスト２の実行結果
まずはこいつが出てくる。
次はこいつ。
んで、こうなる。
リスト２の説明
カラクリはこうだ。
まず、(1)の
hoge = "ち～んｗ"
で、変数hogeに「ち～んｗ」が代入される。
次に、(2)でhogeをhogeCalledByRefに渡して処理をさせるわけだが、参照渡しなので、
hogeCalledByRefにhogeが値を保持しているメモリ上の位置を教えている
ことになる。
ここで処理がhogeCalledByRefに移る。hogeCalledByRefでは、変数strで引数を受け取るわけだが、「参照渡し」で受け取っているので、
strの中にはhogeの値を保持しているメモリ上の位置情報が入っている
と思えば良い。
だから、(3)の
MsgBox str
で、メッセージボックスに表示するためにプロシージャがstrの中身を取得しようとするが、そこにあるのは変数hogeのメモリ番地情報なので、そこを見に行って文字列「ち～んｗ」を得る。
だから、１回目のメッセージボックスには「ち～んｗ」が表示される。
その後、(4)の
str = "(ﾟДﾟ)ﾊｧ?"
で、strに「(ﾟДﾟ)ﾊｧ?」を代入している。代入しているといっても、strの正体はhogeの参照先なので、当然、
変数hogeの値を保持するメモリ上の位置に文字列「(ﾟДﾟ)ﾊｧ?」が書き込まれる
ことになる。
だから、(5)の
MsgBox str
を実行すると、メッセージボックス（２回目）には「(ﾟДﾟ)ﾊｧ?」が表示される。
ここで、hogeCalledByRefプロシージャが終わるので、処理が元のhogeCallerに戻る。
んで、(6)の
MsgBox hoge
で、メッセージボックスに表示するためにプロシージャがhogeの中身を得ようとするのだが、hogeが参照しているメモリ上の位置には、既にhogeCalledByRefプロシージャ内の(4)で「(ﾟДﾟ)ﾊｧ?」が書き込まれているので、当然プロシージャはhogeの値として「(ﾟДﾟ)ﾊｧ?」を得て、メッセージボックス（３回目）に「(ﾟДﾟ)ﾊｧ?」を表示する。
ざっと、こんな理屈で処理が進んでいたわけだ。
まとめ
このような理屈なので、基本的に値だけしか持たない変数を参照渡しにする意味はまるでないと思う。
変数の中身をいじくりたいのなら、変数を宣言したプロシージャ・メソッド内でやるべきであり、わざわざスコープ外でやる意義が見いだせないからだ。
んじゃ、なんで「参照渡し」なんてものがあるのか？
現時点での素人考えだけれど、
値渡しのしようがないものがある
からだと思う。
簡単な例だと、Excelのとあるセルを引数にしたいとき、
セルを値渡しにする
なんて意味不明でしょ？
「オブジェクト」レベルのものになると「値渡し」なんてしようがない。やりたくてもできない。だから、
Sub hogeHoge(ByVal cell As Range)
とか書いても、コンパイルエラーになって実行すらさせてくれないのだろう。
逆に、「整数」とか「文字列」といったものなら、
純粋な単独データ
として存在しうる。
そもそも「整数」とか「文字列」といったプリミティブなデータについて「値渡し」とか「参照渡し」について議論すること自体が無意味なんじゃないのかなあ……？
「値渡し」なんてしようのないデータ型があるから、「参照渡し」という概念が存在して、プリミティブなデータ型についても「参照渡し」自体はできるから「値渡し」も「参照渡し」もできるようになっている、そういうふうに理解した方がいいんでないか。
改めて入門者向けの書籍の「値渡し」・「参照渡し」の箇所を読んでみてそう思ったのだった。
追記
thom (id:t-hom)さんからのご指摘で、
Sub hogeHoge(ByVal cell As Range)
というのも普通にできると分かった。前に何かで「ByValなんてできねーよ、ハゲ！」みたいなエラーが出たことがあって、ずっと勘違いしていたみたい。でも、分かったつもりになっていた「値渡し」・「参照渡し」がまたまたよく分からなくなってしまった。情けないけど、今後の宿題ということにしよう。
練習問題
次のコードを実行したらどうなるか、考えてみてください。
リスト３
Sub pCaller()
Dim x As Integer
x = 10
Debug.Print "１：xの値は " & x & " ですわ。"
Debug.Print "２：xを値渡しの引数にしてpCalledWithValプロシージャを呼びまんねん。"
Call pCalledWithVal(x)
Debug.Print "５：処理がpCallerに帰ってきたで。xの値は、 " & x & " でんがな。"
Debug.Print "６：じゃ、今度はxを参照渡しの引数にしてpCalledWithRefプロシージャを呼ぶぜ。"
x = 10
Call pCalledWithRef(x)
Debug.Print "９：処理がpCallerに帰ってきたのう。xの値は、 " & x & " になっとりますの。"
End Sub
Sub pCalledWithVal(ByVal x As Integer)
Debug.Print "３：こちらpCalledWithVal。今から受け取った" & x & " を10倍しまぁす。" & _
"STAP細胞はありまぁす。"
x = x * 10
Debug.Print "４：こちらpCalledWithVal、受け取った x を10倍したので、xは" & x & "ですわ。"
End Sub
Sub pCalledWithRef(ByRef x As Integer)
Debug.Print "７：こちらpCalledWithRef。今から受け取った" & x & " ば10倍するばい。"
x = x * 10
Debug.Print "８：こちらpCalledWithRef、受け取った x ば10倍したけん、xは" & x & "ばい。" & _
"まさに、10倍ばい！"
End Sub
実際に、試してみてください。
条件付き書式をまじめに勉強してみた(2)
自動記録されたコードを編集する
前回
のつづき。
仕様
まず、自動記録されたコードは、Ａ３セルの値しか条件判定に使うことができない、というおっそろしくしょぼいものなので、選択範囲内全てにＡ列のセルの値次第で書式設定をするというものに変える。仕様としては、とりあえず
- 選択された範囲について、Ａ列の日付が土曜日か日曜日だったら、その行全てを薄いグレーで塗りつぶす。
というものにする。
元のコード
自動記録されたコードを再掲する。
リスト１
Sub Macro1()
Cells.FormatConditions.Delete '……(1)'
Range("A3").Select
Selection.FormatConditions.Add _
Type:=xlExpression, _
Formula1:= _
"=OR(WEEKDAY($A$3)=1,WEEKDAY($A$3)=7)" '……(2)'
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority '……(3)'
With Selection.FormatConditions(1).Interior '……(4)'
.PatternColorIndex = xlAutomatic '……(5)'
.ThemeColor = xlThemeColorDark1 '……(6)'
.TintAndShade = -0.14996795556505 '……(7)'
End With
Selection.FormatConditions(1).StopIfTrue = False '……(8)'
End Sub
コードの改良
まずは、(1)。
Cells.FormatConditions.Delete
これだと、シート上の全セルの条件を消してしまうことになる。いくらなんでもこれは乱暴なので、
Selection.FormatConditions.Delete
と、選択範囲内の条件を削除するにとどめる（でいいんですよね？）。
んで、(2)。
Selection.FormatConditions.Add _
Type:=xlExpression, _
Formula1:= _
"=OR(WEEKDAY($A$3)=1,WEEKDAY($A$3)=7)"
これだと、条件判定に使えるセルがＡ３セル決め打ちになってしまうので変える。
あと、選択範囲内の全てのセルに条件設定をしないといけないので、For Each ～ Nextを使う。
Dim objCell As Range
For Each objCell In Selection
objCell.FormatConditions.Add _
Type:=xlExpression, _
Formula1:="=OR(WEEKDAY(A" & objCell.Row & ")=1," & _
"WEEKDAY(A" & objCell.Row & ")=7)"
objCell.FormatConditions(1)_
.Interior.Color = myLightGray
Next
といったところか。
ちなみに、「myLightGray」ってのはユーザー定義定数ってやつで、モジュールの宣言セクションに
Const myLightGray As Long = 14277081
と記述してある。
14277081というナゾの数字は、
こうしてから、
こうやって求めた。
これで、書式設定したい行に応じて選択範囲内全てのセルに条件付き書式の設定ができる。
ところで、元のコードの(3)～(8)、すなわち、
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority '……(3)' With Selection.FormatConditions(1).Interior '……(4)' .PatternColorIndex = xlAutomatic '……(5)' .ThemeColor = xlThemeColorDark1 '……(6)' .TintAndShade = -0.14996795556505 '……(7)' End With Selection.FormatConditions(1).StopIfTrue = False '……(8)'
は、(4)を除いてばっさりポアｗ
だって、何の役に立ってるんだか分からないんだものｗ
これで、全体のコードはこうなる。
リスト２
Sub setFormatConditionTest()
Selection.FormatConditions.Delete
Dim objCell As Range
For Each objCell In Selection
objCell.FormatConditions.Add _
Type:=xlExpression, _
Formula1:="=OR(WEEKDAY(A" & objCell.Row & ")=1," & _
"WEEKDAY(A" & objCell.Row & ")=7)"
objCell.FormatConditions(1)_
.Interior.Color = myLightGray '……(*)'
Next
End Sub
ただ、どうも(*)のところがどうも気にくわない。なんか、ブサイクなんですよ。
んで、しばらくggってみたところ、FormatConditionオブジェクトの取得については、コチラによると、
FormatConditionsコレクションオブジェクトのAddメソッドは実行されると、Addメソッドで新たに追加されたばかりのFormatConditionオブジェクトを返してきます。
ということらしいので、Addメソッドの返り値であるFormatConditionオブジェクトを即変数にセットしてしまえばよいと分かった。たとえば、
Dim tgtFormatCondition As FormatCondition
Set tgtFormatCondition = _
objRange.FormatConditions.Add _
(Type:=xlExpression, _
Formula1:= _
"=OR(WEEKDAY($A$3)=1,WEEKDAY($A$3)=7)")
とすれば、Ａ３セルに条件をセットしたのと同時にその条件を変数にセットしたことになるわけだ。
あとは、変数tgtFormatConditionを利用して条件を満たす場合の書式を書けばよい。
そうして書き換えたのがコチラ。
リスト３
Sub setFormatConditionTest()
Selection.FormatConditions.Delete
Dim objCell As Range
Dim tgtFormatCondition As FormatCondition '……(1)'
For Each objCell In Selection
Set tgtFormatCondition = _
objCell.FormatConditions.Add _
(Type:=xlExpression, _
Formula1:="=OR(WEEKDAY(A" & objCell.Row & ")=1," & _
"WEEKDAY(A" & objCell.Row & ")=7)") '……(2)'
tgtFormatCondition.Interior.Color = myLightGray
Next
End Sub
ずいぶんスッキリしたぞ。
リスト３の説明
(1)の
Dim tgtFormatCondition As FormatCondition
は、FormatCondition型の変数tgtFormatConditionの準備。こんな型があったんですねえ。
(2)の
Set tgtFormatCondition = _
objCell.FormatConditions.Add _
(Type:=xlExpression, _
Formula1:="=OR(WEEKDAY(A" & objCell.Row & ")=1," & _
"WEEKDAY(A" & objCell.Row & ")=7)")
は長いけど作りは単純。右辺のFormatConditionsコレクションのAddメソッドで変数objCellが指し示すセルに条件を設定し、ということはつまり、新たにFormatConditionオブジェクトを作り出して、変数tgtFormatConditionにセットしているだけ。
TypeとかFormula1というのはAddメソッドの引数で、それぞれ数式を条件とすること、その数式、を表している。
ちなみに、Formula1プロパティの値を
"=OR(WEEKDAY(A" & objCell.Row & ")=1," & _ "WEEKDAY(A" & objCell.Row & ")=7)")
と、「=1,」の後ろで一旦ダブルクオーテーションを閉じて行継続文字で改行しているが、これは単に可読性だけの問題。本来こんなところで改行する必要はない。
実行
範囲を選択して、マクロを実行すると、
ほれ、この通り、条件付き書式が適用されている。
おわりに
まだまだ決め打ちみたいな処理しかできないので、もっと柔軟な処理ができるようにしたいなあ。
条件付き書式をまじめに勉強してみた
条件付き書式を設定するマクロ
年度最終日、さっさと仕事を済ませて華麗に帰ってやろうと思っていたのだが、新年度すぐに使う予定表に一つ機能を付け加え忘れていたことに気づいた。ワンクリックで１年分のカレンダーが更新されるようにしていたのに、土日のセルの色を変える条件付き書式を設定し忘れていたのだった。
ついこないだまでExcelど素人だった私。条件付き書式は普段あまり使うことがないので、いざやろうとしたら結構時間がかかってしまったのだった。
結局、単純作業の繰り返しに陥ってしまったので、以後こんなことにならないよう、自身の勉強も兼ねてブログに書いておくことにした。
マクロ記録してみる
まずは、Ａ３セルに入っている日付が、土曜日か日曜日だったら、セルの背景を明るいグレーにする、という条件付き書式の設定をマクロ記録してみた。
「条件付き書式」→「ルールの管理」の順にクリックしたら、
こんなのが出てくるので、この画面で「新規ルール」をクリック。
すると、こんなやつが出てくるので、「数式を使用して、書式設定をするセルを決定」を選んで、「次の数式を満たす場合に値を書式設定」（変な日本語だな、オイ）欄に今回は、
OR(WEEKDAY($A$3)=1,WEEKDAY($A$3)=7)
を入力。「Ａ３セルの日付が土曜日か日曜日だったらTrue」という条件だ。
次に、「書式」ボタンをクリックすると、
こんなのが出てくるので、明るいグレーのところ（赤枠のところね）をクリックして[ＯＫ]。そうしたら、
こんなふうになる。これで[ＯＫ]をクリックしたら設定完了。ここでマクロ記録終了。
ちなみに、ワークシート上ではこうなっている。画像のトリミングの仕方がおかしいな、オイ！ グレーになっているところがＡ３セルです。
自動記録されたコード
んで、できたのが次のコード。改行とかタブとかちょっと整えてるけど。
リスト１
Sub Macro1()
Cells.FormatConditions.Delete '……(1)'
Range("A3").Select
Selection.FormatConditions.Add _
Type:=xlExpression, _
Formula1:= _
"=OR(WEEKDAY($A$3)=1,WEEKDAY($A$3)=7)" '……(2)'
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority '……(3)'
With Selection.FormatConditions(1).Interior '……(4)'
.PatternColorIndex = xlAutomatic '……(5)'
.ThemeColor = xlThemeColorDark1 '……(6)'
.TintAndShade = -0.14996795556505 '……(7)'
End With
Selection.FormatConditions(1).StopIfTrue = False '……(8)'
End Sub
うひゃあ、相変わらずイヤーなコードだｗ 見たことないようなプロパティが多いしｗ
何やってんだか解読してみよう。
リスト１の説明
まず、(1)なんだが、
Cells.FormatConditions.Delete
ん？ Cells？……ってことは、一旦全てのセルの条件を削除しちまってるのか！？ ってことは、安易に実行したら消されちゃ困る条件まで巻き添えで消されてしまうってことなのか？？？
で、(2)
Selection.FormatConditions.Add _
Type:=xlExpression, _
Formula1:= _
"=OR(WEEKDAY($A$3)=1,WEEKDAY($A$3)=7)"
ちょっと行継続文字をこまめに入れてある。選択中のセル（Selection）のFormatConditionsコレクションに、AddメソッドでFormatConditionオブジェクトを追加している。
引数のTypeってのはよく分からないんだけど、
によると、定数「xlExpression」が「演算」という意味のようだから、「数式を使用して、書式設定するセルを決定」を選んだ、という意味なんだろう。
んで、(3)。
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
FormatConditionsコレクションのインデックスに「Selection.FormatConditions.Count」を渡している。(1)で一旦FormatConditionをクリアした後、(2)のAddメソッドでFormatConditionオブジェクトを追加しているんだから、当然この時点でCountプロパティの値は「1」。要するに、さっき新たに追加したFormatConditionオブジェクトを指しているということなんだな……。
なんでこんなめんどくせーことするんだ？？？
すみません。取り乱しました。要するに、(2)で新たに追加したFormatConditionオブジェクトのSetFirstPriorityメソッドを使っているわけだが、
条件付き書式ルールの優先度の値を "1" に設定し、ワークシート内の他のルールより先に評価されるようにします。
……。これ、いる？？？
優先も何も、条件１つしかないのに……。
次は、(4)。
With Selection.FormatConditions(1).Interior
って、今度はFormatConditionsコレクションのインデックスは「1」なのかよｗ さっきの「Selection.FormatConditions(Selection.FormatConditions.Count)」ってのは何だったんだ？？？
それはともかく、FormatConditionオブジェクトのInteriorプロパティまでをWithでまとめているので、ここから先はセル（今回の場合はＡ３セル）の見た目を操作していくことになるはず。
(5)～(7)はいっぺんに行こう。
.PatternColorIndex = xlAutomatic '……(5)' .ThemeColor = xlThemeColorDark1 '……(6)' .TintAndShade = -0.14996795556505 '……(7)'
は、は～～～ん？？？
何でColorプロパティがないんだ？？？
すまん。(5)については、たぶん、
ということなんだと思う。
(7)については、
色を明るく、または暗くする単精度浮動小数点型 (Single) の値を設定します。
ということだそうだから、マクロ記録にありがちな
デフォルトで何ら問題なくて普段意識することすらないプロパティの設定をバカ正直にやっている
というだけのことだろう。
しかしながら、(6)はさっぱり分からん。
それ以上になんでColorプロパティに関する記述がないのか、もっと分からん。だれか、詳しい人は教えろてください。
またしても取り乱してしまった。気を取り直して(8)。
Selection.FormatConditions(1).StopIfTrue = False
StopIfTrueというのは、「条件を満たす場合は停止」のチェックのことで、こういうことらしい。
複数条件があるようなときは、結構重要なんだろうが、今回のように条件式が１つしかないときは、別にどうでもいいよね？
次回予告
う～～～ん、思ってた以上に手強いぞ、条件付き書式。
次回から、このコードを改良していこう。
画像をクリックしたら画像のあるセルに現在時刻を書き込むマクロ
クリックされた図形のあるセルを取得する
前置き
「画像をクリックしたら、その画像のあるセルに現在時刻を書き込むようなことってできない？」と言われたのでやったことがあった。
Excelで勤怠管理の一覧表を作って、出勤時と退勤時にその日の欄にある画像をクリックするだけで時刻を書き込めるように、ということらしい。
ちょこちょこっとggってみると、こんなのが引っかかった。なるほど、画像にマクロを登録して、そのマクロの中でApplication.Caller
というプロパティの値を取得すれば、マクロの呼び出し手、すなわちマクロを登録した画像そのものが取得できるわけだな。ややこしい言い方ですまん。
あと、こういうのも引っかかってくる。
コチラによると、shapeオブジェクトにはTopLeftCellという非常に便利なプロパティがあり、
オブジェクトの左上端にあるセルを表す Range オブジェクトを返します
ということだ。
前置きが長くなったけど、要するに、
- セルの中に画像を置く
- クリックされた画像の左上端のあるセルに現在時刻を書き込むマクロを作る
- 画像に(2)で作ったマクロを登録する
というやり方でいけるはず。
マクロの作成
Application.Callerプロパティ、shapeオブジェクトのTopLeftCellプロパティという非常に便利なものがあるおかげで、めちゃくちゃ簡単なコードでいけそう。
リスト１
標準モジュールに次のコードを書く。
Option Explicit
Sub setTimeByButtonClick()
Dim strAddress As String
With ActiveSheet
strAddress = _
.Shapes(Application.Caller).TopLeftCell.Address '……(1)'
.Range(strAddress).Value = Now() '……(2)'
End With
End Sub
なんと、たったのこれだけｗ
リスト１の説明
まず、Application.Callerがこのマクロの呼び出し元のオブジェクト名を返すから、Shapesコレクションのインデックス（？）のところにApplication.Callerを入れてやることで、マクロ呼び出し元画像オブジェクト（＊）を取得することができる。
んで、（＊）のTopLeftCellプロパティは、オブジェクトの左上端にあるセルを表す Range オブジェクトを返しますということなので、そのAddressプロパティを取得してやれば、セルの番地が得られることになる。
ごく短いコードだけど、ここまでを理解しておくことが前提かな。
- (1)では、上記のように、
クリックされた画像オブジェクトの取得→画像オブジェクトの左上端のあるセルの取得→セルのアドレス文字列を取得
の順でクリックされた画像のあるセルのアドレスを取得して変数strAddressに格納している。 - (2)では、Rangeプロパティの引数に(1)で取得したアドレス文字列を指定してセルを取得し、そのValueプロパティにNow関数によって現在日時をセットしている。
(2)でTimeではなくNowにしたのは、日付が変わってから退勤する場合に備えるため。
実行
画像をクリックすると、
時刻が無事に書き込まれた。
おわりに
ごく短いコードだったけれど、知っておくと便利な要素が結構詰まっている気がする。
小さなクラスを作る(7)～セルの列符号が簡単に取得できるラッパークラス
列符号取得が可能なRangeオブジェクトのラッパークラス
きっかけ
「列番号はColumプロパティで簡単に取得できるのに、列符号って取り出しにくいよなー」と思って、コチラを参考にXDF列までに対応した自作関数を作ったのがそもそもの始まり。
他のよく使う機能を一つのモジュールにまとめて使い回していたんだが、モジュール内のプロシージャが増えるにつれ、管理がいい加減になってしまって、放置プレーになってしまっていた。
ブックＡに仕込んだ○○プロシージャは修正したけど、ブックＢの○○プロシージャは以前のまま、みたいな。
ちょうどクラスモジュールの練習中でもあるので、
一つのセルを包み込んで、列符号を尋ねたら応えてくれて、なおかつRangeオブジェクトの諸機能もそのまま使える
クラスを作ってみようと思い立った。
これを「ラッパークラス」と呼んでよいものかどうかは自信がないので、達人のみなさん、ツッコミよろしく！
準備
クラスモジュールを挿入して、オブジェクト名を「WrappedCell」にする。
リスト1-1 宣言セクション
Option Explicit '自作エラー情報のための構造体 '……(1)' Private Type errorType Number As Long Description As String End Type '拡張できるように配列で宣言 '……(2)' Private myError() As errorType 'エラーインデックス用の番号を列挙体で準備 '……(3)' Private Enum errIndex CELL_NOT_SINGLE = 0 'セルが複数渡された CELL_NOT_GOT 'セル未取得 End Enum
リスト1-1の説明
まずは下ごしらえ。普通はフィールドの宣言から始めるけど、今回はちょっと違う。
- (1)では、自作エラーを表示するために、ErrオブジェクトのRaiseメソッドの引数用の構造体を準備した。まあ、たった２つのパラメータごときを構造体にまとめるというのは鶏を割くに牛刀を用いるの観なきにしもあらずだが、使わないと忘れるので。
- (2)では、(1)で準備したerrorType型の変数myErrorを配列で準備している。あとで自作エラーの種類を増やすときに楽なようにこうした。他にもエラーを吐かせるべきことがあるかも知れんので。いわゆるYAGNIの原則には反しますがｗ
- (3)では、 id:imihitoさんのこのとき のアドヴァイス
処理のブロックに番号をつけるときに列挙型（Enum）を使うと、識別子を付けられるのでただの数字より見やすくなってオススメ
を生かして配列myErrorのインデックス番号を列挙体で準備した。今後、エラーの種類を増やすときは、ここで番号に意味のある文字列を割り振ったら良い。
リスト1-2 フィールド
'フィールド Private oneSelf_ As Range Private columnLetter_ As String
リスト1-2の説明
とりあえず、包み込む対象のセルそのものと、そのセルの列符号をフィールドとして持たせることにした。他になんかあるだろうか？？？
リスト1-3 アクセサ(1)
'アクセサ
Public Property Set oneSelf(ByRef newCell As Range)
If newCell.Count <> 1 Then '……(1)'
Call raiseError(errIndex.CELL_NOT_SINGLE) '……(2)'
Exit Property
End If
Set oneSelf_ = newCell '……(3)'
End Property
Public Property Get oneSelf() As Range
If oneSelf_ Is Nothing Then '……(4)'
Call raiseError(errIndex.CELL_NOT_GOT) '……(5)'
End If
Set oneSelf = oneSelf_
End Property
リスト1-3の説明
珍しくProperty Set(Let)を書いた。
Javaファンの私からすると、Propertyプロシージャってなんだかヘンテコリンな感じがするので、別途Setterメソッドを作るという手もあったんですけどね。
- (1)では、このクラスに渡されるRangeオブジェクトをチェック。
- このクラスは、あくまでも単一のセルを包み込むのが目的なので、複数セルが渡されたら(2)でエラーを吐かせる。プログラマに知らせることが目的なのであえてエラーを吐かせるのだ。
エラー表示用のraiseErrorメソッドは後で実装する。 - (1)のIf節を何事もなく通過したら(3)で仮変数oneSelf_に渡されたセルをセットしている。
ちなみに、(1)のIfに対応したElse節内に書くこともできるが、あえてこうしている。
というのも、「If～Else」を多用すると可読性が落ちる（Elseの条件は、If、ElseIfと見比べないと分からない）ため。「ガード節」というらしい。たしかに「If～Else」って読みにくいときがあるんだよな。 - (4)も(1)と同じ。oneSelfプロパティにセルがセットされていないのに呼び出そうとしたら(5)でエラーを吐く。まあ、なくても普通にエラーが出るだろうけど、こうした方が原因が特定しやすいと思うので。
リスト1-4 アクセサ(2)
Public Property Get columnLetter() As String
If oneSelf_ Is Nothing Then
Call errorRaiser(errIndex.CELL_NOT_GOT)
Exit Property
End If
Dim iAlpha As Integer '列符号最上位けた'
Dim iBeta As Integer '列符号中位けた'
Dim iRemainder As Integer '列符号最下位けた'
With oneSelf_
If .Column > 702 Then '列番号が702を超えるとき、列符号は３けた '……(1)'
iAlpha = Int((.Column - 27) / 676) '……(2)'
columnLetter_ = Chr(iAlpha + 64) '……(3)'
iBeta = Int(((.Column - (iAlpha * 676)) - 1) / 26) '……(4)'
columnLetter_ = columnLetter_ & Chr(iBeta + 64)
iRemainder = (.Column - (iAlpha * 676) - (iBeta * 26))
columnLetter_ = columnLetter_ & Chr(iRemainder + 64)
ElseIf .Column > 26 Then '列番号が26を超えるとき、列符号は２けた '……(5)'
iBeta = Int((.Column - 1) / 26)
columnLetter_ = Chr(iBeta + 64)
iRemainder = .Column - (iBeta * 26)
columnLetter_ = columnLetter_ & Chr(iRemainder + 64)
Else '列番号26までは列符号１けた '……(6)'
iRemainder = .Column
columnLetter_ = Chr(iRemainder + 64)
End If
End With
columnLetter = columnLetter_
End Property
リスト1-4の説明
ココが今回のメイン。列番号の取得はめっちゃ簡単なのに、列符号の取得のなんとメンドウなことよ。高校１年程度の数学ができるんならこのコードは理解できると思う。(1)～(3)がどうしても理解できないんならあきらめてください。
- (1)。まず、１列目（Ａ）～26列目（Ｚ）は列符号１けた。これは楽勝ですな。んで、27列目（AA）から702行目（ZZ）が列符号２けた。
アルファベット２字の組み合わせは26×26＝676通り。AAから数えて676番目のZZは、そこまでの26を足して702番目になるでしょ？ - (2)は、列符号の左端の文字を求めるための計算。ZZ（702列目）の次がAAA（703列目）ってのがミソ。
703列目以降は、BAA列が（27＋676）＋676＝1379列目、CAA列が（27＋676）＋676＋676＝2055列……というように、左端のアルファベットが進んでいくので、左端のアルファベットは[列数－27を676で割った商]番目のアルファベット、ということになる。 - 何番目のアルファベットかさえわかれば、あとは、その数字を文字に変換してやればよい。アルファベットの大文字「A」は文字コードが65番目なので、Chr関数の引数に[(2)で求めた数＋64]を渡してやれば、めでたくアルファベットが得られる。
- (1)～(3)が理解できるなら、(4)はもはや説明不要だろう。
列番号から676のかたまりを除去すると、後は右の２けたの問題ですからね。
AAA列を例にとると、703－676－1＝26、26÷26＝１なので、真ん中のアルファベットは１番目、すなわちＡということ。 - (5)は２けたになるとき、(6)は１けたになるとき、それぞれ同じような理屈で文字に変換している。
リスト1－5 コンストラクタとメソッド
'コンストラクタ
Private Sub Class_Initialize()
ReDim myError(2) As errorType '……(1)'
With myError(0)
.Number = 10000
.Description = "WrappedCellのoneSelfプロパティに複数のセルを渡すことはできません。"
End With
With myError(1)
.Number = 10001
.Description = "WrappedCellのoneSelfプロパティにセルがセットされていません。"
End With
End Sub
'メソッド
Private Sub raiseError(ByVal errIndex As Integer) '……(2)'
Err.Raise myError(errIndex).Number, myError(errIndex).Description
End Sub
リスト1－5の説明
珍しくコンストラクタの出番。このクラス独自のエラーをセットしている。
- (1)では、今のところエラーの種類は２種類だけなので、RedimしてそれぞれNumberとDescripitionをセットしている。
- (2)は、自作エラーを吐かせるメソッド。クラスの内部でしか使わないのでPrivateにしている。こんなもん、あっちこっちで使われたらかなわんしｗ
引数として配列のインデックス番号を受け取って、それに応じたNumberとDescriptionをセットしているだけ。
実行
標準モジュールのコード
Sub test05() Dim target As WrappedCell Set target = New WrappedCell Set target.oneSelf = Selection Debug.Print target.columnLetter Set target = Nothing End Sub
実行結果
セルを選んで、実行すると、
ほれ、この通り列符号が取得できた。
結合されたセルでも
大丈夫。
ただし、複数セルを選択して実行すると
エラーを吐く。
「[WrappedCellクラスのインスタンス].oneSelf.」まで入力すると、
このようにインテリセンスが働くので、Rangeオブジェクトのプロパティ・メソッドが普通に使える。
おわりに
とりあえず、何の役に立つのか分からないけど、今後拡張できたらしてみよう。
……とここまで書いてきてアレなんだが、
セルの列符号ぐらい、もっと簡単に取得できるんじゃね？
と思ってしまったのだった。
リスト2
Sub test06()
Dim tgtCell As Range
Set tgtCell = ActiveCell
Dim str As String
Dim chr As String
Dim i As Integer
Dim tmp As String
str = Replace(tgtCell.Address, "$", "")
For i = 1 To Len(str)
chr = Mid(str, i, 1)
If chr Like "[0-9]" Then
chr = ""
End If
tmp = tmp & chr
Next
str = tmp
Debug.Print str
End Sub
リスト2の実行結果
AZN５セルを選択して実行すると、
でけとる……。
む、むなしい……orz
フォルダ構成を別のフォルダにコピーするマクロ(3)
一覧表のデータを元にフォルダ構成を移植する
いよいよ今回のマクロも完成。
今回は、前回のマクロで作成したフォルダの一覧表を元に、別のフォルダにフォルダ構成を再現する処理を書いていく。
処理の下準備
リスト1-1
Sub moveFolderStructure()
Dim objSh As Worksheet
Set objSh = ActiveSheet
With objSh
If .Range("A3").Value = "" Then '……(1)'
MsgBox "フォルダフルパスが空白なので処理できません。", vbCritical
Exit Sub
End If
Dim lastRw As Integer
lastRw = .Cells(Rows.Count, 1).End(xlUp).Row '……(2)'
End With
リスト1-1の説明
処理を始めるための準備みたいなところ。
- (1)は、Ａ３セルが空白かどうかで条件分岐。Ａ３セルに何も入っていなければ、そもそもフォルダ構成が取得できていないということなので、メッセージを表示して処理を終える。
- (2)はおなじみ、データのある最終行番号を求める計算。データ転記系の処理ではマジでよく使うので、入門者は理屈とともに手が勝手に動くレベルまで習熟すべし。
コピー先の親フォルダのフルパス取得
当ブログではもはやおなじみ、FolderPickerクラスを使う。
リスト1-2
Dim rootPath As String
Set fldPicker = New FolderPicker '……(1)'
MsgBox "フォルダ構成のコピー先となる親フォルダを指定せよ。"
With fldPicker
.showFolderPicker '……(2)'
If .isCancelled = True Then '……(3)'
Exit Sub
End If
rootPath = fldPicker.gotFolder '……(4)'
End With
リスト1-2の説明
もはや説明不要かも知れんけど、一応。
- (1)はおなじみ、FolderPickerクラスをインスタンス化。ひつこいようだけど、ここから先は変数fldPickerをさながらフォルダパス等の取得屋さんのように使える。
「fldPickerさ～ん、ちょっとフォルダ選択ダイアログを表示して～！」とか、「fldPickerさ～ん、フォルダのフルパスを教えて～！」みたいな感じ。クラスを作るメリットの一つだと思う。 - (2)がまさに「fldPickerさ～ん、ちょっとフォルダ選択ダイアログを表示して～！」。
- (3)の「fldPicker.isCancelled」の取得は「fldPickerさ～ん、キャンセルされた？」てな感じ。
- (4)は、さしづめ「fldPickerさ～ん、ちょっと選択されたフォルダのフルパスを教えて？ rootPathに代入すっからさ！」てな感じかな。
「クラス」というものを使うと、まるでオブジェクトと会話するような感じでプログラミングできる、というメリットがある。もちろん、クラス名やフィールド名、メソッド名を適切につけた場合に限るんだろうけど。
フォルダ構成の複製
いよいよここからがメインの処理。
リスト1-3
Dim i As Integer '……(1)'
Dim n As Integer '……(2)'
Dim strPath As String '……(3)'
With ObjSh
For i = 3 To lastRw '……(4)'
n = 2 '……(5)'
strPath = .Cells(i, n).Value '……(6)'
Do While .Cells(i, n).Offset(0, 1).Value <> "" '……(7)'
strPath = strPath & "\" & _
.Cells(i, n).Offset(0, 1).Value '……(8)'
n = n + 1 '……(9)'
Loop
strPath = rootPath & "\" & strPath '……(10)'
If Dir(strPath, vbDirectory) = "" Then '……(11)'
MkDir strPath '……(12)'
End If
Next
End With
MsgBox "フォルダ構成の複製が終わりました。"
End Sub
リスト1-3の説明
- (1)でループカウンタ i を宣言。一覧表を行方向に進んでいくのに使う。
- (2)でループカウンタ n を宣言。コチラは、一覧表を列方向に進んでいくのに使う。
- (3)は、フォルダパスを格納するのに使う変数。
- (4)は、行方向のループ設定。３行目から最終行まで回す。
- (5)で n の初期値を設定。今回使用するワークシートでは、Ａ列、すなわち１列目には元のフォルダのフルパスが入っている。個々のフォルダ名は２列目以降に入っているので、n の初期値は 2 となる。
- (6)で、まず i 行目の１つ目（Ｂ列）のフォルダ名をstrPathに格納。
- (7)は、(7)からの５行（実質４行）のDoループの継続条件。１つ右のセルが空白になるところまで右へ右へ進んでいくイメージ。
- (8)では、１つ右のセルに入っているフォルダ名を、アタマに「\」をつけてstrPathに連結している。
たとえば、strPathに「A」、１つ右のセルに「B」が入っていたら、この段階でstrPathの中身が「A\B」（＝Aフォルダの中にあるBフォルダ）になっているということ。 - (9)で n をインクリメント。
- (7)のDoループを抜けた段階で、strPathにはサブフォルダのフォルダパスが格納されているので、あとは(10)で、そのアタマに、移動先のフォルダパスと「\」を連結してやれば、サブフォルダのフルパスができる。
- (11)で既にそのフォルダがあるかどうかを判定し、なければ(12)のMkDirステートメントで作成する。
あとは、 i が最終行番号に達するまで繰り返す。こうすることで、新たにフォルダ構成だけを指定のセルに書き込むことができる。
実行
ボタンをクリックしてマクロ起動。
フォルダを選べ、と言われるので、
フォルダを選択すると、
あっという間に完了。
「ち～んｗ」フォルダ内にフォルダができている。Bフォルダの中にC、Dフォルダがあることが分かる。Eフォルダもある。
おわりに
同じフォルダ構成を繰り返し用いる業務があるなら、ファイルはコピーせずにフォルダ構成だけを複製することができるこのマクロはなかなか便利だと思う。
