要素数「1」の配列(アホネタ)
要素数 1 の配列
のコメント欄で、VBA四天王のうちの二天王から、次のようなことを教えていただいた。すなわち、
- 配列の次元数の上限は60
- 各次元に0と1の二つの添え字を持たせるとして、最小のByte型配列を利用しても、2の次元乗バイトのメモリが必要なので、4GB使って22次元まで、60次元扱うには1エクサバイト必要
と。
ふむ。なるほど、むやみに次元数は増やせないものなのだなあ。
しかし! 要素数が「1」なら、60次元ぐらい余裕じゃね???
要素数が1つだけの配列って、作れるのだろうか。やってみた。
リスト1 標準モジュール
Public Sub testArray() Dim ar(0) As String ar1(0) = "ち~んw" Debug.Print ar(0) End Sub
コイツを実行すると、
普通に実行できる。
はっ!
では、
夢の60次元配列も作れるのでは!?
夢の60次元配列を作ってみる
うおおお! やってやるぜえ!!!!!!!
はっ!
コレ、どうやって値を代入すりゃいいんだ……???
おわりに
アホっぷりを大いにさらしてしまったorz
フォルダ選択ダイアログを表示させるFunction(2)
フォルダ選択ダイアログを表示させるFunctionを改良する
FileDialog.InitialFileNameプロパティ
このときに作成したFunctionをちょっと改良する。
このFunctionを使ってフォルダ選択ダイアログを表示させたとき、いつも不便なフォルダ(たぶん、「既定の保存場所」か何か)が最初に表示されるので、目的のフォルダまでチマチマとたどっていかねばならず、めんどくせーなーと思っていたのだ。特に、職場だと共有ドライブを使っているので、実にメンドクサイ。
そこで、ちょっと調べてみると、FileDialog.InitialFileNameプロパティというものをセットすれば良いらしいと分かった。
おなじみコチラによると、
ファイル ダイアログ ボックスに最初に表示されるパスまたはファイル名を表す String を設定するか返します。値の取得および設定が可能です。
構文
式 . InitialFileName
式FileDialog オブジェクトを表す変数を指定します。
とのこと。
特に職場では、マクロを仕込んだブックのあるフォルダがデフォルトになっていると便利だと思ったので、
のリスト1を次のように書き換えた。
リスト1 標準モジュール
Public Function getSelectedFolderPath( _ Optional ByVal defaultFolderPath As String, _ Optional ByVal titleOfDialog As String) As String If defaultFolderPath = "" Then _ defaultFolderPath = ThisWorkbook.Path '……(1)' If Dir(defaultFolderPath, vbDirectory) = "" Then _ defaultFolderPath = ThisWorkbook.Path Dim folderPath As String Dim isSelected As Boolean With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = defaultFolderPath '……(2)' If titleOfDialog <> "" Then .Title = titleOfDialog Else .Title = "フォルダ選択" End If isSelected = .Show If isSelected Then getSelectedFolderPath = .SelectedItems(1) Else getSelectedFolderPath = "" End If End With End Function
変えたのは2箇所。
まず、(1)からの実質2行
If defaultFolderPath = "" Then defaultFolderPath = ThisWorkbook.Path If Dir(defaultFolderPath, vbDirectory) = "" Then defaultFolderPath = ThisWorkbook.Path
まず、引数defaultFolderPathが""だったら、このブックのあるフォルダパスをdefaultFolderPathにセットする。
次に、Dir関数を使って、defaultFolderPathで指し示されるフォルダが存在するかどうか調べ、存在しなかったらこのブックのあるフォルダパスをdefaultFolderPathにセットする。
これで、実在する何らかのフォルダパスがdefaultFolderPathにセットされていることになる。
後は、(2)の
Application.FileDialog(msoFileDialogFolderPicker) _ .InitialFileName = defaultFolderPath
で、InitialFileNameプロパティにdefaultFolderPathの値をセット。
これでShowメソッドを実行したときにdefaultFolderPathで指し示すフォルダが最初に表示されることになる。
おわりに
あとは、このときに選択したフォルダパスの文字列をどこかで保持しておくようにすれば、一旦ブックを閉じた後でも「前回選択したフォルダからスタート」なんてことができるようになる。
Iteratorクラスを作ってみた
Iteratorクラスを作ってみた
デザインパターンをまじめに勉強したくなったので、遊び半分でコーディング。
Iteratorクラス
オブジェクト名は「Iterator」です。
リスト1ー1 クラスモジュール 宣言セクション
Option Explicit Private Const ERROR_NOT_INITIALIZED As String = _ "Iteratorクラスのinitメソッド未実行" Private cnt As Long Private isInitialized As Boolean Private vault_ As Variant Private countOf_ As Long Private hasNext_ As Boolean Private hasPrevious_ As Boolean
リスト1ー2 クラスモジュール Property部
Public Property Get hasNext() As Boolean If Not isInitialized Then Call raiseErrorNotInitialized hasNext = hasNext_ End Property Public Property Get getNext() As Variant If Not isInitialized Then Call raiseErrorNotInitialized If Not hasNext_ Then Exit Property If VarType(vault_.Item(cnt)) = vbObject Then Set getNext = vault_.Item(cnt) Else getNext = vault_.Item(cnt) End If cnt = cnt + 1 If cnt > countOf_ Then cnt = countOf_: hasNext_ = False End Property Public Property Get hasPrevious() As Boolean If Not isInitialized Then Call raiseErrorNotInitialized If cnt > 1 Then hasPrevious_ = True hasPrevious = hasPrevious_ End Property Public Property Get getPrevious() As Variant If Not isInitialized Then Call raiseErrorNotInitialized If Not hasPrevious_ Then Exit Property If VarType(vault_.Item(cnt)) = vbObject Then Set getPrevious = vault_.Item(cnt) Else getPrevious = vault_.Item(cnt) End If cnt = cnt - 1 If cnt < 1 Then cnt = 1: hasPrevious_ = False End Property
メソッドにすべきか迷ったが、せっかくPropertyという便利な仕組みがあるのだから、本家Iteratorのhasnext、nextいづれもPropertyにした。
ただし、「next」は予約語で使えないので、「getNext」にしてある。
リスト1ー3 クラスモジュール Constructor部
Private Sub Class_Initialize() cnt = 1 hasNext_ = True hasPrevious_ = False End Sub Public Function init(ByRef object_ As Variant) As Boolean On Error GoTo errorHandler If IsArray(object_) Then vault_ = object_ Set vault_ = convertArrayToCollection(object_) countOf_ = vault_.Count init = True isInitialized = True Exit Function End If If TypeName(object_) = "Collection" Then Set vault_ = object_ countOf_ = vault_.Count init = True isInitialized = True Exit Function End If If TypeName(object_) = "Dictionary" Then Set vault_ = convertArrayToCollection(object_.Items) countOf_ = vault_.Count init = True isInitialized = True Exit Function End If errorHandler: init = False isInitialized = False End Function
例によって、VBAはコンストラクタに引数を渡せないクソ仕様なので、コンストラクタが2段階になる。
2段階目のinitメソッドでは、受け取ったものが配列だろうがCollectionだろうがDictionaryだろうが、全てCollectionに突っ込むという処理を行っている。
ちなみに、convertArrayToCollectionというのは、
のリスト1です。
リスト1ー4 クラスモジュール その他
Private Sub raiseErrorNotInitialized() Err.Raise Number:=10001, _ description:=ERROR_NOT_INITIALIZED End Sub
2段階目のコンストラクタ未実行のままPropertyを参照したらエラーを吐くようにするためのメソッド。インスタンスから呼ばれたら困るからPrivate指定。
使ってみる
下記のコードで実行。
リスト2 標準モジュール
Public Sub hoge() Dim ar(2) As String ar(0) = "アホ" ar(1) = "ボケ" ar(2) = "カス" Dim dic As New Scripting.Dictionary With dic .Add Key:="a1", _ Item:="ち~んw" .Add Key:="a2", _ Item:="プヒー!" .Add Key:="a3", _ Item:="( ´,_ゝ`)プッ" .Add Key:="a4", _ Item:="( ´_ゝ`)フーン" End With Dim cl As New Collection With cl .Add "バカ" .Add "クズ" .Add "デコスケ" End With Dim it1 As New Iterator Call it1.init(ar) Do While it1.hasNext Debug.Print it1.getNext Loop Dim it2 As New Iterator Call it2.init(dic) Do While it2.hasNext Debug.Print it2.getNext Loop Dim it3 As New Iterator Call it3.init(cl) Do While it3.hasNext Debug.Print it3.getNext Loop Debug.Print it1.hasNext Debug.Print it2.hasNext Debug.Print it3.hasNext Debug.Print it1.hasPrevious Debug.Print it2.hasPrevious Debug.Print it3.hasPrevious Do While it1.hasPrevious Debug.Print it1.getPrevious Loop End Sub
無駄にタテに長いコードだが、勘弁してほしい。
参照設定で「Microsoft Scripting Runtime」にチェックを入れるのを忘れないようにしてください。
配列、Scripting.Dictionary、Collectionを渡して、要素を順に取り出しているだけ。
実行結果
いちおう、意図どおりの出力が得られている。
おわりに
「だから何?」とか言わないでください。
自分でも何の役に立つのか分からないし、これをどうしたら良いのかも分かりません。
これでIteratorになっているのかどうかも不明。
達人のアドヴァイス、お待ちしております。
「デザインパターン」シリーズ、この後も続くのだろうか……???
配列の次元数を取得するFunction
配列の次元数を取得する
何気なく配列をぐりぐりいじくっていたときに、ちょっとした間違いで
こんなエラーが出た。まあ、よくあるエラーなんだが、このときは要素数を超えたのではなくて、存在しない次元を指定していたのだった。
ということは、LBoundとかUBoundみたいな
配列の次元数(Dimension)を引数に持つ関数
に 1 づつインクリメントした数を渡していけば、配列次元数を超えたところでエラーが出るということだ。
というわけで、配列の次元数を取得するFunctionを作ってみた。
配列の次元数を返すFunction
リスト1 標準モジュール
Public Function getArrayDimension( _ ByRef targetArray As Variant) As Long '……(1)' If Not IsArray(targetArray) _ Then getArrayDimension = False: Exit Function '……(2)' Dim n As Long '……(3)' n = 0 Dim tmp As Long On Error Resume Next '……(4)' Do While Err.Number = 0 n = n + 1 tmp = UBound(targetArray, n) Loop Err.Clear getArrayDimension = n - 1 '……(5)' End Function
(1)の
Public Function getArrayDimension(ByRef targetArray As Variant) As Long
では、引数と返り値を設定。どんな配列が渡されるか分からないので、Variant型。返り値はInteger型でも良いと思うのだけれど、100万次元ぐらいの配列が渡されるかも知れないので(←ねえよw)Longにした。
追記
id:imihito さんによると、配列の次元数は60が最大、とのこと(コメント欄参照)。要するに、非常にマヌケなことを書いてしまっているということですね。まあ、大は小を兼ねるわけですから、このままLongっちゅうことにしときます。
(2)の
If Not IsArray(targetArray) Then getArrayDimension = False: Exit Function
はガード節。IsArray関数を使って配列かどうかを判定し、配列でなければ即Falseを返してFunctionを抜ける。
返り値は別に「0」で良いと思うが、Falseとした方が分かりやすいと思った。
(3)からの2行
Dim n As Long n = 0
では変数 n を用意して 0 で初期化。別にInteger型でも良いと思うのだけれど、100万(以下ry
この n は、後でインクリメントしてUBound関数に渡すために使う。
関係ないけれど、こういう野暮ったい書き方を見ると、
int n = 0;
みたいに書ける言語が羨ましくなる。
(4)からの6行
On Error Resume Next Do While Err.Number = 0 n = n + 1 tmp = UBound(targetArray, n) Loop Err.Clear
まず
On Error Resume Next
でエラーが出ても処理を続行するように指定しておく。
Do While Err.Number = 0
としているので、Doループのブロック突入時にErrオブジェクトのNumberプロパティを調べて、「0」すなわちエラーが出ていなければブロック内に突入することになる。
ブロック内に突入すると、まず
n = n + 1
で n をインクリメントし、
tmp = UBound(targetArray, n)
でUBound関数の引数Dimensionに渡す。
この段階で n が引数で渡された配列targetArrayの次元数を超えていたらエラーが発生して次へ進むことになる。
ちなみに、変数tmpはUBound関数を使うための単なるアテ馬w
Doループ内でエラーが発生したらループを抜けて、
Err.Clear
でErrオブジェクトをリセットしておく。
この段階で、変数 n には、引数で渡された配列targetArrayの要素数 + 1 が格納されているはずなので、(5)の
getArrayDimension = n - 1
をreturnしておしまい。
使ってみた
次のコードで実行。
リスト2 標準モジュール
Public Sub testGetArrayDimension() Dim ar1(1, 1, 1) As String Debug.Print getArrayDimension(ar1) Dim ar2(1, 1, 1, 1, 1, 1, 1) Debug.Print getArrayDimension(ar2) Debug.Print getArrayDimension("ち~んw") Debug.Print Not getArrayDimension("ち~んw") End Sub
リスト1のgetArrayDimensionを、それぞれ
- 3次元配列を渡す――(1)
- 7次元配列を渡す――(2)
- 配列でないただの文字列を渡す――(3)
- (3)の結果をNotする――(4)
形で実行している。
実行結果
意図したとおりの結果となった。
ちなみに、「0」はFalse、「ー1」はTrueなので、Not Falseの形でTrueも表現できる。
おわりに
相変わらず、何に使うのかは不明ですがw
Scripting.Dictionaryの要素をCollection化するFunction
Scripting.Dictionaryの要素をCollection化するFunction
Scripting.DictionaryクラスのItemsメソッド
何気なくScripting.Dictionaryクラスのインスタンスをぶち込んだ変数の後に「.」(ドット)を打ち込んだら、
Intellisenseでこんなのが出た。
よく見たら、「Items」ってのがメソッドのアイコン付きで出ている。
「Items」なんて、まるでCollectionみたいな名前なのに、メソッドってどういうことだろう?
調べてみた
おなじみMSDNで調べてみると、
Items メソッド
Dictionary オブジェクト内のすべての項目を格納した配列を返します。
だとさ。
どうも、Scripting.Dictionaryの要素のうち、「Key」ではなく「Item」の方を配列にして返すメソッドらしい。
……ということは、
このときのFunctionを使ったら、Scripting.Dictionaryの要素もCollection化できてしまうことになる!
やってみた
VBEの「ツール」→「参照設定」へと進み、「Microsoft Scripting Runtime」にチェックを入れて、次のコードで実験してみる。
リスト1 標準モジュール
Public Sub testDicToCllection() Dim dic As New Scripting.Dictionary '……(1)' With dic .Add Key:="a1", _ Item:="ち~んw" .Add Key:="a2", _ Item:="プヒー!" .Add Key:="a3", _ Item:="( ´,_ゝ`)プッ" .Add Key:="a4", _ Item:="( ´_ゝ`)フーン" End With Dim cl As New Collection Set cl = convertArrayToCollection(dic.Items) '……(2)' Dim i As Integer For i = 1 To cl.Count Debug.Print cl.Item(i) Next End Sub
まず(1)からの11行(実質7行)
Dim dic As New Scripting.Dictionary '……(1)' With dic .Add Key:="a1", _ Item:="ち~んw" .Add Key:="a2", _ Item:="プヒー!" .Add Key:="a3", _ Item:="( ´,_ゝ`)プッ" .Add Key:="a4", _ Item:="( ´_ゝ`)フーン" End With
で要素数4のScripting.Dictionaryのインスタンスを生成。
Itemsメソッドが配列を返すということなので、
dic.Items
を(2)の
Set cl = convertArrayToCollection(dic.Items)
で前回記事のリスト1のFunctionに渡して、返り値をCollection型の変数clにぶち込む。
これで、変数clにはScripting.Dictionaryのインスタンスdocの要素(「Item」の方)が格納されているはずなので、後はForループで1つづつ取り出してDebug.Printでイミディエイトに表示する。
実行結果
意図どおりの結果となった。
おわりに
前回記事の内容と今回記事の内容を踏まえて、無駄にIteratorクラスを作ってみたりしています。近日公開予定!
配列の要素をCollection化するFunction
配列の要素をコレクション化するFunction
配列の要素をコレクションに格納する
ちょっと思いつきで作ってみた。
リスト1 標準モジュール
Public Function convertArrayToCollection( _ ByRef targetArray As Variant) As Collection If Not IsArray(targetArray) Then Exit Function Dim tmp As New Collection Dim i As Long For i = LBound(targetArray) To UBound(targetArray) tmp.Add targetArray(i) Next Set convertArrayToCollection = tmp End Function
見ての通り、引数で渡された配列の要素を1つ1つ取り出してコレクションにAddしているだけ。
使ってみた
次のコードで実行。
リスト2 標準モジュール
Public Sub testArrayToCollection() Dim ar(3) As String '……(1)' ar(0) = "アホ" ar(1) = "ボケ" ar(2) = "クズ" ar(3) = "デコスケ" Dim cl As New Collection '……(2)' Set cl = convertArrayToCollection(ar) Dim i As Integer With cl For i = 1 To .Count Debug.Print cl.Item(i) Next End With End Sub
まず(1)からの5行
Dim ar(3) As String ar(0) = "アホ" ar(1) = "ボケ" ar(2) = "クズ" ar(3) = "デコスケ"
で、実験用に要素数4のString型配列ar()を用意。
(2)からの2行
Dim cl As New Collection Set cl = convertArrayToCollection(ar)
で、Collection型の変数clをNewして、リスト1のFunctionの返り値をセット。
後は、Forループで要素を1つ1つ取り出してDebug.Printでイミディエイトに表示しているだけ。
実行結果
ひとまず、意図どおり。
ただし、1次元配列にしか対応していないので、なんだかなあ、である。
ユーザー設定のドキュメントプロパティを気軽に使う
ユーザー設定のドキュメントプロパティを操作するFunction
このときに、処理用パラメータの保存場所としてユーザー設定のドキュメントプロパティを使ったが、もっと気軽に使えるようにFunction化しておいた。
追加用Function
リスト1 標準モジュール
Public Function addDocumentProperty(ByVal propName As String, _ ByVal propType As MsoDocProperties, _ ByVal defaultValue As Variant) _ As Boolean '……(1)' On Error GoTo errorHandler '……(2)' ThisWorkbook.CustomDocumentProperties.Add Name:=propName, _ LinkToContent:=False, _ Type:=propType, _ Value:=defaultValue '……(3)' addDocumentProperty = True: Exit Function '……(4)' errorHandler: '……(5)' setDocumentProperty = False End Function
(1)の
Public Function addDocumentProperty(ByVal propName As String, _ ByVal propType As MsoDocProperties, _ ByVal defaultValue As Variant) _ As Boolean
は、引数と返り値の設定。
第1引数はプロパティ名。
第2引数はプロパティの型。MsoDocProperties型を指定しているので、インテリセンスが効く。
ちなみに、MsoDocProperties列挙体のメンバは
- msoPropertyTypeBoolean
- msoPropertyTypeDate
- msoPropertyTypeFloat
- msoPropertyTypeNumber
- msoPropertyTypeString
となっている。まあ、どれがどの型なのかはだいたい名前で見当がつくな。Numberだけはよく分からんけど。
第3引数は初期設定のプロパティ値。色んな型が指定できそうなのでVariantにした。
で、別にSubでも良いと思ったんだが、うまく設定できずにエラーが出るようなこともあると思ったので、Functionにして、うまく行ったらTrue、失敗したらFalseを返すようにした。
したがって、(2)の
On Error GoTo errorHandler
でエラー時にはキャッチするようにした。
(3)の
ThisWorkbook.CustomDocumentProperties.Add Name:=propName, _ LinkToContent:=False, _ Type:=propType, _ Value:=defaultValue
が処理の本体。たったこんだけ。
CustomDocumentPropertiesコレクションのAddメソッドを実行しているだけ。
(4)の
addDocumentProperty = True: Exit Function
までたどり着いたということは、エラーが出ずに無事addメソッドが実行されたということなので、Trueを返して抜ける。
どこかでエラーが発生していたら、(5)の
errorHandler: setDocumentProperty = False
に飛ばされるので、Falseを返して抜ける。
削除用
リスト2 標準モジュール
Public Function deleteDocumentProperty(ByVal propName As String) As Boolean On Error GoTo errorHandler ThisWorkbook.CustomDocumentProperties.Item(propName).Delete '……(6)' deleteDocumentProperty = True: Exit Function errorHandler: deleteDocumentProperty = False End Function
エラー対応についてはリスト1と全く同じなので省略。
(6)の
ThisWorkbook.CustomDocumentProperties.Item(propName).Delete
で、CustomDocumentPropertiesコレクションのDeleteメソッドを実行してユーザー設定のドキュメントプロパティを削除しているだけ。
使ってみた
次のコードで上記2つのFunctionを使ってみた。
リスト3 標準モジュール
Public Sub setPropertiesTest() Call addDocumentProperty(propName:="hoge", _ propType:=msoPropertyTypeString, _ defaultValue:="foo") MsgBox ThisWorkbook.CustomDocumentProperties.Item("hoge").Value Call deleteDocumentProperty("hoge") End Sub
「hoge」という名前のString型のドキュメントプロパティを設定し、初期値を「foo」にする。
その後、プロパティ「hoge」の値をメッセージボックスで表示し、「hoge」そのものを抹殺する、というマクロ。
「ファイル」タブ、「情報」の右の方、
ココをクリックして、
ココをクリックして、
ココをクリックすると、
ココにたどり着く。
まだユーザー設定のドキュメントプロパティが設定されていないことが分かる。
リスト3の実行をココで中断して、もう一度見てみると、
ほれ、「hoge」が追加されておる。値も「foo」。意図した通り。
したがって、当然、メッセージボックスには、
「foo」が表示される。
んで、この後「hoge」は抹殺されるので、実行終了後もう一度見に行くと、
キッチリ抹殺されている。
おわりに
これで気軽に使えるようになった。
使う機会はそんなにないだろうけど。