要素数「1」の配列(アホネタ)

素数 1 の配列

akashi-keirin.hatenablog.com

のコメント欄で、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

コイツを実行すると、

f:id:akashi_keirin:20180311181849j:plain

普通に実行できる。

はっ!

では、

夢の60次元配列も作れるのでは!?

夢の60次元配列を作ってみる

うおおお! やってやるぜえ!!!!!!!

f:id:akashi_keirin:20180311181856j:plain

はっ!

コレ、どうやって値を代入すりゃいいんだ……???

おわりに

アホっぷりを大いにさらしてしまったorz

@akashi_keirin on Twitter

フォルダ選択ダイアログを表示させるFunction(2)

f:id:akashi_keirin:20180310154006j:plain

フォルダ選択ダイアログを表示させるFunctionを改良する

FileDialog.InitialFileNameプロパティ

akashi-keirin.hatenablog.com

このときに作成したFunctionをちょっと改良する。

このFunctionを使ってフォルダ選択ダイアログを表示させたとき、いつも不便なフォルダ(たぶん、「既定の保存場所」か何か)が最初に表示されるので、目的のフォルダまでチマチマとたどっていかねばならず、めんどくせーなーと思っていたのだ。特に、職場だと共有ドライブを使っているので、実にメンドクサイ。

そこで、ちょっと調べてみると、FileDialog.InitialFileNameプロパティというものをセットすれば良いらしいと分かった。

おなじみコチラによると、

ファイル ダイアログ ボックスに最初に表示されるパスまたはファイル名を表す String を設定するか返します。値の取得および設定が可能です。

構文

式 . InitialFileName

式FileDialog オブジェクトを表す変数を指定します。

とのこと。

特に職場では、マクロを仕込んだブックのあるフォルダがデフォルトになっていると便利だと思ったので、

akashi-keirin.hatenablog.com

リスト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というのは、

akashi-keirin.hatenablog.com

リスト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を渡して、要素を順に取り出しているだけ。

実行結果

f:id:akashi_keirin:20180310100630j:plain

いちおう、意図どおりの出力が得られている。

おわりに

「だから何?」とか言わないでください。

自分でも何の役に立つのか分からないし、これをどうしたら良いのかも分かりません。

これでIteratorになっているのかどうかも不明。

達人のアドヴァイス、お待ちしております。

デザインパターン」シリーズ、この後も続くのだろうか……???

配列の次元数を取得するFunction

配列の次元数を取得する

何気なく配列をぐりぐりいじくっていたときに、ちょっとした間違いで

f:id:akashi_keirin:20180310094500j:plain

こんなエラーが出た。まあ、よくあるエラーなんだが、このときは要素数を超えたのではなくて、存在しない次元を指定していたのだった。

ということは、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関数を使うための単なるアテ馬

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)

形で実行している。

実行結果

f:id:akashi_keirin:20180310094507j:plain

意図したとおりの結果となった。

ちなみに、「0」はFalse、「ー1」はTrueなので、Not Falseの形でTrueも表現できる。

おわりに

相変わらず、何に使うのかは不明ですがw

@akashi_keirin on Twitter

Scripting.Dictionaryの要素をCollection化するFunction

Scripting.Dictionaryの要素をCollection化するFunction

Scripting.DictionaryクラスのItemsメソッド

何気なくScripting.Dictionaryクラスのインスタンスをぶち込んだ変数の後に「.」(ドット)を打ち込んだら、

f:id:akashi_keirin:20180309211937j:plain

Intellisenseでこんなのが出た。

よく見たら、「Items」ってのがメソッドのアイコン付きで出ている。

「Items」なんて、まるでCollectionみたいな名前なのに、メソッドってどういうことだろう?

調べてみた

おなじみMSDNで調べてみると、

Items メソッド

Dictionary オブジェクト内のすべての項目を格納した配列を返します。

だとさ。

どうも、Scripting.Dictionaryの要素のうち、「Key」ではなく「Item」の方を配列にして返すメソッドらしい。

……ということは、

akashi-keirin.hatenablog.com

このときの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でイミディエイトに表示する。

実行結果

f:id:akashi_keirin:20180309211945j:plain

意図どおりの結果となった。

おわりに

前回記事の内容と今回記事の内容を踏まえて、無駄にIteratorクラスを作ってみたりしています。近日公開予定!

@akashi_keirin on Twitter

配列の要素を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でイミディエイトに表示しているだけ。

実行結果

f:id:akashi_keirin:20180309205053j:plain

ひとまず、意図どおり。

ただし、1次元配列にしか対応していないので、なんだかなあ、である。

@akashi_keirin on Twitter

ユーザー設定のドキュメントプロパティを気軽に使う

ユーザー設定のドキュメントプロパティを操作するFunction

akashi-keirin.hatenablog.com

このときに、処理用パラメータの保存場所としてユーザー設定のドキュメントプロパティを使ったが、もっと気軽に使えるように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」そのものを抹殺する、というマクロ。

「ファイル」タブ、「情報」の右の方、

f:id:akashi_keirin:20180306215425j:plain

ココをクリックして、

f:id:akashi_keirin:20180306215438j:plain

ココをクリックして、

f:id:akashi_keirin:20180306215446j:plain

ココをクリックすると、

f:id:akashi_keirin:20180306215456j:plain

ココにたどり着く。

まだユーザー設定のドキュメントプロパティが設定されていないことが分かる。

f:id:akashi_keirin:20180306215507j:plain

リスト3の実行をココで中断して、もう一度見てみると、

f:id:akashi_keirin:20180306215516j:plain

ほれ、「hoge」が追加されておる。値も「foo」。意図した通り。

したがって、当然、メッセージボックスには、

f:id:akashi_keirin:20180306215525j:plain

「foo」が表示される。

んで、この後「hoge」は抹殺されるので、実行終了後もう一度見に行くと、

f:id:akashi_keirin:20180306215533j:plain

キッチリ抹殺されている。

おわりに

これで気軽に使えるようになった。

使う機会はそんなにないだろうけど。

@akashi_keirin on Twitter