［Range］.MergeAreaプロパティの返り値の謎(Excel)
[Range].MergeAreaプロパティの返り値の謎
単にRangeオブジェクトのことがよく分かっていないだけかも知れないが、恥を承知で書く。
MergeAreaプロパティの返り値
こんなシートがあったとする。
Ｊ１セルとＪ２セルが結合されている。
したがって、Ｊ１セルのMergeAreaプロパティとＪ２セルのMergeAreaプロパティとは、同じRangeオブジェクトを返すはずだ。
で、イミディエイト・ウインドウに
?range("J1").MergeArea = range("J2").MergeArea
と入力して[Enter]をポチッ。
あっ、非常に素人臭いことをしてしまった……（いや、素人なんですけどね）。
気を取り直して、イミディエイト・ウインドウに
?range("J1").MergeArea is range("J2").MergeArea
と入力して[Enter]をポチッ。
ファッ！？
Falseが返るんすかーーー？！
Addressプロパティで比較する
ならばと今度は、Addressプロパティを調べてみる。
イミディエイト・ウインドウに、
?range("J1").MergeArea.Address
?range("J2").MergeArea.Address
と入力して、それぞれ結果を見てみると、
ごく当り前の結果が出ている。
当然、
?range("J1").MergeArea.Address = range("J2").MergeArea.Address
だと、
となる。
おわりに
あるセルと別のあるセルとが同じ結合セルに含まれているかどうかを判定するには、MergeAreaプロパティの返り値であるRangeオブジェクトの何らかのプロパティの助けを借りねばならんのだろうか。
ファイル名に接頭辞・接尾辞を附加するFunction
ファイル名に接頭辞・接尾辞を附加するFunction
ファイル名変換ツールを自作したときに、ついでに作った。
ファイル名に接頭辞を付けるFunction
これは簡単。単純に先頭に文字列を追加するだけ。
リスト１ 標準モジュール
Public Function getPrefixedFileName( _
ByVal fileName As String, _
ByVal prefixString As String) As String
getPrefixedFileName = prefixString & fileName
End Function
説明するのもあほらしくなるような簡単なコード。
ファイル名に接尾辞を付けるFunction
これはちょっとめんどくさい。ファイル名の文字列から〈「.」（ドット）も含めた拡張子〉を除いた文字列に、接尾辞の文字列を附け加える。
リスト２ 標準モジュール
Public Function getSuffixedFileName( _
ByVal fileName As String, _
ByVal suffixString As String) As String
Dim positionOfDot As Long
positionOfDot = InStrRev(fileName, ".") '……(1)'
Dim nameString As String
nameString = Left(fileName, positionOfDot - 1) '……(2)'
Dim extentionWithDot As String
extentionWithDot = Replace(fileName, nameString, "") '……(3)'
getSuffixedFileName = nameString & suffixString & extentionWithDot
End Function
まず(1)の
positionOfDot = InStrRev(fileName, ".")
で、InStrRev関数を用いて、ファイル名文字列のケツから「.」（ドット）を探す。
InStrRev関数の返り値は、前から何文字目かを表す数値になるので注意。
これで、拡張子を表す「.」（ドット）の位置が分かる。
次に(2)の
nameString = Left(fileName, positionOfDot - 1)
では、先ほど求めた拡張子を表す「.」（ドット）の位置をもとに、Left関数で、
〈「.」（ドット）も含めた拡張子〉を除いた文字列
を切り出す。
例えば、「ち～んｗ.docx」というファイル名だとすると、まず
InStrRev("ち～んｗ.docx", ".")
が「5」を返すので、positionOfDotは「5」となる。
んで、
Left("ち～んｗ.docx", 5 - 1)
が「ち～んｗ」を返すので、nameStringは「ち～んｗ」になる、というわけ。
あと、(3)の
extentionWithDot = Replace(fileName, nameString, "")
で、Replace関数を用いて、元のファイル名のうち、〈「.」（ドット）も含めた拡張子〉を除いた文字列を「""」で置換することによって、〈「.」（ドット）も含めた拡張子〉を取り出す。
これはいろいろなやり方ができると思う。Right関数使うとか。
最後に、〈「.」（ドット）も含めた拡張子〉を除いた文字列、接尾辞、〈「.」（ドット）も含めた拡張子〉をつなぎ合わせておしまい。
使ってみる
イミディエイト・ウインドウ上で、getPrefixedFileNameとgetSuffixedFileNameに、引数「ち～んｗ.docx」と「【プヒー！】」を渡してみる。
意図どおりの結果となった。
おわりに
まあ、一つのFunctionにまとめてしまって、引数で接頭辞か接尾辞かに分岐する方法もあると思う。
ファイルのコピーを作成する（FileSystemObjectオブジェクトのCopyFileメソッド）
ファイルのコピーを作成する
FileSystemObjectオブジェクトを用いる。
ファイルのコピーを作成するFunction
FileSysetmObjectオブジェクトのCopyFileメソッドをラップする。
参照設定でMicrosoft Scripting Runtimeにチェックを入れておく。
リスト１ 標準モジュール
Public Function createCopyFile(ByVal oldFullName As String, _
ByVal newFullName As String) As Boolean
createCopyFile = False
If Dir(oldFullName, vbNormal) = "" Then Exit Function
On Error Resume Next
Err.Clear
Dim fileSystemObject_ As New FileSystemObject
Call fileSystemObject_.CopyFile(Source:=oldFullName, _
Destination:=newFullName)
If Err.Number > 0 Then Exit Function
On Error GoTo 0
createCopyFile = True
End Function
元ファイルのフルパスと新ファイルのフルパスを引数として処理をする。ファイルコピーに成功したらTrue、失敗したらFalseを返すようにした。
使ってみる
F:\お持ち帰り\ち～んｗフォルダ内に、このようにたくさんのファイルが入っている。
シートのＤ１セルに、コピーを作成したいファイルがあるフォルダのパスが入力されている。
で、シートのＡ列にこんなふうにファイル名が列挙されている。
この状態で、シートＡ列のファイル名が入っているセルを全て選択し、次のコードで実験。
リスト２ 標準モジュール
Public Sub testCreateCopyFile()
Dim targetFolderPath As String
targetFolderPath = Sheet1.Range("D1").Value
Dim targetCell As Range
For Each targetCell In Selection
With targetCell
If Not createCopyFile( _
targetFolderPath & .Value, _
targetFolderPath & "backup\" & .Value) Then Exit Sub
End With
Next
End Sub
元のファイルがあるF:\お持ち帰り\ち～んｗフォルダ内のbackupフォルダ内に、全てのファイルのコピーを作成するコード。
実行結果
F:\お持ち帰り\ち～んｗ\backupフォルダを開けてみると、
この通り、全てのファイルがコピーされている。
おわりに
Webページにupするために、大量のファイル名を１バイト文字のみのファイル名に変換する必要があって、簡単なファイル名変換ツールを作った。そのとき、バックアップを取る機能を付けるために、久しぶりにFileSystemObjectオブジェクトを使ったので、覚書的に書き残すことにした。
ファイル名をチェックするFunction
不正なファイル名を検出するFunction
作ってみた。
コード
コードは次の通り。
リスト１ 標準モジュール
Public Function hasProhibitedCharacter( _
ByVal fileName As String) As Boolean '……(1)'
hasProhibitedCharacter = True '……(2)'
Dim ar As Variant
ar = Array("\", "/", ":", "*", "?", "<", ">", "|") '……(3)'"
Dim i As Long
For i = 0 To 7 '……(4)'
If InStr(fileName, ar(i)) > 0 Then Exit Function
Next
hasProhibitedCharacter = False '……(5)'
End Function
(1)の
Public Function hasProhibitedCharacter(ByVal fileName As String) As Boolean
は引数と返り値の設定。ファイル名を表す文字列を受け取って、結果をBooleanで返す。
(2)の
hasProhibitedCharacter = True
でひとまず返り値をTrueにしておく。
こうしておくと、不正な文字を検出した瞬間にExit Functionするだけで済む。
(3)の
ar = Array("\", "/", ":", "*", "?", "<", ">", "|")
で、禁則文字を配列化。
あとは、(4)からの３行
For i = 0 To 7 If InStr(fileName, ar(i)) > 0 Then Exit Function Next
で、引数fileName内に禁則文字があったら、その時点でExitするようにしている。
これで、禁則文字が１つでもあったらTrueが返ることになる。
(4)のForループを無傷で通り抜けると、そこには(5)の
hasProhibitedCharacter = False
が待っている。ここまで来たということは、禁則文字がファイル名に使われていなかったということなので、Falseをreturnしておしまい。
使ってみる
禁則文字がないので、Falseが返った。
禁則文字「\」があるので、Trueが返った。
禁則文字「/」があるので、Trueが返った。
禁則文字「*」があるので、Trueが返った。
以下略。
おわりに
こういうちょっとしたものをため込んでおくと便利。ただし、数が多くなってくると、モジュールを分けて気の利いた名前を付けて整理するとかしておかないと、せっかく作った便利メソッドが埋もれてしまう。
追記
thom (id:t-hom)さんからコメントをいただき、上掲リスト１の(3)のところでSplit関数を用いることにした。
各要素を半角スペースで区切り、Split関数の第２引数を省略すると、第２引数に半角スペースを指定したのと同じになるらしい。
たしかに、いちいち一つづつ「"」で括ってArray関数を使うよりかなり楽だ。
ついでに、Forループ用のカウンタもLboundとUboundで指定するようにした。
まあ、禁則文字が増減することはあまりないだろうし、マジックナンバーといえど、このプロシージャ内で完結しているので、無問題とは思いますが……。
リスト２ 標準モジュール
Public Function hasProhibitedCharacter(ByVal fileName As String) As Boolean
hasProhibitedCharacter = True
Dim ar As Variant
ar = Split("\ / : * ? < > |")
Dim i As Long
For i = LBound(ar) To UBound(ar)
If InStr(fileName, ar(i)) > 0 Then Exit Function
Next
hasProhibitedCharacter = False
End Function
シートモジュールとインターフェイス
シートモジュールにインターフェイスを実装する
単なる実験。
インターフェイスを作成する
クラスモジュールを挿入して、次のコードを書く。
オブジェクト名はIA1ValueShowableとする。
ちなみに、Instancingプロパティの値を「PublicNotCreatable」にしています。
リスト１ クラスモジュール
Option Explicit Public Sub showA1Value() End Sub
たったこれだけ。showA1Valueというメソッドだけを定義しておく。
これで、このインターフェイスをImplementsしたオブジェクトには、必ずshowA1Valueというメソッドを持たせなくてはならないことになる。
シートモジュールにインターフェイスを実装する
今回は、Sheet6モジュールとSheet7モジュールの２つにインターフェイス「IA1ValueShowable」を実装する。
リスト２ Sheet6モジュール
Option Explicit
Implements IA1ValueShowable
Public Sub IA1ValueShowable_showA1Value()
Call makeUserSick(Me.Range("A1").Value)
End Sub
Sheet6モジュールのshowA1Valueメソッドでは、当ブログではおなじみのmakeUserSickメソッドを使用してＡ１セルの値を表示する。
makeUserSickメソッドについては、コチラをどうぞ。
リスト３ Sheet7モジュール
Option Explicit
Implements IA1ValueShowable
Public Property Get BASE_CELL() As Range
Set BASE_CELL = Me.Range("A1")
End Property
Public Sub IA1ValueShowable_showA1Value()
Call MsgBox(Me.Range("A1").Value)
End Sub
Propertyのところは前回の名残。
Sheet7モジュールのshowA1Valueメソッドでは、単なるMsgBoxを使う。
これで準備完了。
使ってみる
標準モジュールに次のコードを書いて実行してみる。
リスト４ 標準モジュール
Public Sub testInterfaceSheetModule()
Dim Sh(1) As IA1ValueShowable '……(1)'
Set Sh(0) = Sheet6 '……(2)'
Set Sh(1) = Sheet7
Dim i As Long
For i = 0 To 1 '……(3)'
Call Sh(i).showA1Value
Next
End Sub
まず、(1)の
Dim Sh(1) As IA1ValueShowable
で、インターフェイスIA1ValueShowable型の配列Shを準備。
(2)からの２行
Set Sh(0) = Sheet6 Set Sh(1) = Sheet7
でSheet6とSheet7を配列Shにぶち込む。
後は(3)からの３行
For i = 0 To 1 Call Sh(i).showA1Value Next
でForループを用いてshowA1Valueメソッドを実行する。
実行結果
このように、同じshowA1Valueメソッドを呼び出すことでそれぞれ異なる動作をさせることができた。
おわりに
Subだとこのようにうまくいったのだが、Range型のPropertyだとうまくいかなかった。なぜだろう。
追記
Propertyの識別子をBase_Cellとしていたのだが、どうも「_」（アンダースコア）がまずかった模様。クラスモジュールIA1ValueShowable内で
Public Property Get Base_Cell() As Range End Property
このように定義し、これに合わせてSheet6、Sheet7モジュールのそれぞれにBase_Cellプロパティを設定したところ、
こんなエラーが出てどうしようもなかったのだが、識別子から「_」を取り除いて次のようなコードにすると上手くいったので、全てのコードを載っけておく。
リスト５ クラスモジュール
'オブジェクト名：IA1ValueShowable' Option Explicit Public Property Get Name() As String End Property Public Property Get BaseCell() As Range End Property Public Sub showA1Value() End Sub
リスト６ Sheet6モジュール
Option Explicit
Implements IA1ValueShowable
Public Property Get IA1ValueShowable_Name() As String
IA1ValueShowable_Name = "Sheet6"
End Property
Public Property Get IA1ValueShowable_BaseCell() As Range
Set IA1ValueShowable_BaseCell = Me.Range("A1")
End Property
Public Sub IA1ValueShowable_showA1Value()
Call makeUserSick(Me.Range("A1").Value)
End Sub
リスト７ Sheet7モジュール
Option Explicit
Implements IA1ValueShowable
Public Property Get IA1ValueShowable_Name() As String
IA1ValueShowable_Name = "Sheet7"
End Property
Public Property Get IA1ValueShowable_BaseCell() As Range
Set IA1ValueShowable_BaseCell = Me.Range("A1")
End Property
Public Sub IA1ValueShowable_showA1Value()
Call MsgBox(Me.Range("A1").Value)
End Sub
リスト８ 標準モジュール
Public Sub testInterfaceSheetModule()
Dim Sh(1) As IA1ValueShowable
Set Sh(0) = Sheet6
Set Sh(1) = Sheet7
Dim i As Long
For i = 0 To 1
Call Sh(i).showA1Value
Debug.Print Sh(i).Name
Debug.Print Sh(i).BaseCell.Value
Next
End Sub
リスト８を実行すると、リスト４実行時同様２つのメッセージが出た後、イミディエイトに
このように表示される。
VBAでインターフェイスを使う場合、どうも「_」（アンダースコア）が特別な意味を持っているらしい。気をつけねば。
追記
面白半分にシートモジュールにインターフェイスを実装すると、えらいことになります。
「オブジェクト型の定数」的なものを設定する
オブジェクト型の定数
定数は便利な仕組みだが、オブジェクト型の定数は指定できないっぽい。
Range型の定数を定義しようとしてみる
標準モジュールの宣言セクションに、次のように書いてみる。
で、[Enter]を押してみると、
こんな風に、コンパイルエラーっぽい状態になる。ただ、エラーメッセージは出ていない。
この状態で、次のコードを実行してみる。
リスト１ 標準モジュール
Public Sub testObjectTypeConstant() Debug.Print BASE_CELL.Value End Sub
すると、
ここでコンパイルエラー。
やっぱり、Range型の定数というのは無理っぽい。
ちなみに、
Private Const Set BASE_CELL As Range = Sheet7.Range("A1")
としても駄目だった。
Propertyを使う
処理の中で基準にするセルなど、特定のRangeオブジェクトを定数みたいにしておくことができたら便利。
で、Propertyを使うことを考えた。
Sheetモジュールに次のコードを書く。
リスト２ シートモジュール
Public Property Get BASE_CELL() As Range
Set BASE_CELL = Me.Range("A1")
End Property
たったこれだけ。Sheet7のBASE_CELLプロパティにＡ１セルを指定。あ、Sheet７の「7」に深い意味はありませんよ。テスト用ブックのワークシートが増えすぎているだけのことですので。
読み取り専用なので、定数っぽく使えると思う。
使ってみる
次のコードで実行。
リスト３ 標準モジュール
Public Sub testObjectTypeConstant() Debug.Print Sheet7.BASE_CELL.Value End Sub
Sheet7は
この状態なので、当然、実行すると、
イミディエイトにこんな風に表示される。
おわりに
各シートのPropertyにすることで、各シートのモジュールにコードを書くことになるので、それぞれのシートの中で独特の役割を持ったセルやセル範囲を一括管理しやすくなると思う。
参考
Propertyを使って配列定数っぽいものを実現する
列挙体とPropertyを組みあわせて配列定数っぽくする
前回
のつづき。
Propertyに配列をセットする
Propertyプロシージャ内でArray関数を用いて、Propertyに配列を持たせるようにした。
標準モジュール
Option Explicit
Private hasGot As Boolean
Private CONST_ARRAY_ As Variant
Public Property Get CONST_ARRAY(ByVal i As Long) As Variant
If Not hasGot Then _
CONST_ARRAY_ = Array("アホ", "バカ", "カス"): hasGot = True
CONST_ARRAY = CONST_ARRAY_(i)
End Property
引数付きにするのが良いのかどうかはわからない。
CONST_ARRAYを参照するたびにArray関数が作動するのもちょっとアレだと思ったので、配列取得済みかどうかをフラグ変数hasGotで判定するようにした。
エラー対応皆無なので、当然引数に存在しないインデックスを渡すと即エラーが出る。
配列のインデックス用に列挙体を作る
配列と列挙体は非常に相性が良いと思うので、引数指定用に列挙体を作った。
リスト２ 標準モジュール
Private Enum Batou アホ バカ カス End Enum
これで、配列のインデックスを有意味な文字列で指定できるようになった。
使ってみる
次のコードで実験。
リスト３ 標準モジュール
Public Sub testConstArray() Debug.Print CONST_ARRAY(アホ) Debug.Print CONST_ARRAY(バカ) Debug.Print CONST_ARRAY(カス) End Sub
おお、わかりやすい！(笑)
こいつを実行すると、
わかりやすい結果だ！（笑）
おわりに
一つのブックの中に、同じ様式のたくさんのシートがあって、それぞれに値を転記していくようなときがある。転記先シートが一つだけなら、データ書き込みセルにそれぞれ名前を付ける、という対処法があるが、同じ様式のシートが複数あると、そのやり方では上手くいかない。
かといって、データ書き込みセルのアドレスを定数にしてしまうと、今度は列挙体に同じ名前が使えなくなってしまう。
標準モジュールのPropertyにするのが適切なやり方なのかどうかはわからないが、こうすることで可読性の高いコードが書けるのではないかと思った。
追記
せっかく列挙体を使うのだから、Property Getの引数を列挙体型にしないと意味がないな、と思ったので、コードを修正。
リスト４ 標準モジュール
Option Explicit Private hasGot As Boolean Private CONST_ARRAY_ As Variant Private Enum Batou アホ バカ カス End Enum Public Property Get CONST_ARRAY(ByVal batou_ As Batou) As Variant If Not hasGot Then _ CONST_ARRAY_ = Array("アホ", "バカ", "カス"): hasGot = True CONST_ARRAY = CONST_ARRAY_(batou_) End Property
Property Getの引数をBatou型にした。投げやりな列挙体名ですまん。
これでコード入力時に
このようにIntellisenseが働いて超便利。
