t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA 複数の変数に同じ値を一気に代入する。

以前の記事でC言語では連続して代入できることを紹介した。
thom.hateblo.jp
たとえば、a=b=c=d=10;とすると、すべての変数に10が入る。

VBAではどうにもならないと思っていたのだが、mmYYmmddさんがブログで面白いアイデアを公開されていたので、そこにヒントを得て一度に複数の変数に代入するプロシージャを作ってみた。

該当の記事はこちら。
mmyymmdd.hatenablog.com

なるほど、代入自体をプロシージャ化してしまうという考えは無かった。斬新である。
さて、mmYYmmddさんが元記事でやりたかったことはうまくいかなかったようだが、私がやりたかった同時代入はできた。

最初はこのようのParamArrayで変数を渡して代入しようとしたが、参照渡しができずに失敗。

Sub Assign(x As Variant, ParamArray arr() As Variant)
    For Each xx In arr
        xx = x
        Debug.Print xx
    Next
End Sub


それなら多少強引ではあるが、Optionalの力技で実現させようということで出来たのがこちら。

Sub Assign(Value As Variant, _
                            v1 As Variant, _
                Optional v2 As Variant, _
                Optional v3 As Variant, _
                Optional v4 As Variant, _
                Optional v5 As Variant, _
                Optional v6 As Variant, _
                Optional v7 As Variant, _
                Optional v8 As Variant, _
                Optional v9 As Variant)
    v1 = Value
    If IsMissing(v2) Then Exit Sub
    v2 = Value
    If IsMissing(v3) Then Exit Sub
    v3 = Value
    If IsMissing(v4) Then Exit Sub
    v4 = Value
    If IsMissing(v5) Then Exit Sub
    v5 = Value
    If IsMissing(v6) Then Exit Sub
    v6 = Value
    If IsMissing(v7) Then Exit Sub
    v7 = Value
    If IsMissing(v8) Then Exit Sub
    v8 = Value
    If IsMissing(v9) Then Exit Sub
    v9 = Value
End Sub

メインプロシージャからはこのように呼び出す。

Sub test()
    Dim a, b, c, d
    Call Assign(10, a, b, c, d)
    Debug.Print a, b, c, d
End Sub

値10を変数a,b,c,dに同時に割り当てることに成功した。


ただ、このAssignプロシージャは最大9つまでしか割り当てができない。
必要十分だとは思うが、もっと増やしたいときにAssignプロシージャをいじるのは面倒だ。
そこでイミディエイトウインドウに任意数まで対応するAssignプロシージャを出力するプログラムを作ってみた。

Sub CreateAssign()
    Dim n As Integer
    n = 20
    Header = "Sub Assign(Value As Variant, v1 As Variant"
    Contents = vbTab & "v1 = Value"
    footer = "End Sub"
    For i = 2 To n Step 1
        Header = Header & ", _" & vbNewLine & vbTab & vbTab & vbTab & _
            "Optional v" & i & " As Variant"
        Contents = Contents & vbNewLine & vbTab & "If IsMissing(v" & i & ") Then Exit Sub" & _
            vbNewLine & vbTab & "v" & i & " = Value"
    Next
    Debug.Print Header & ")" & vbNewLine & Contents & vbNewLine & footer
End Sub

上記ではイミディエイトウインドウのサイズの関係で、25くらいが限界だが、テキストファイル出力にすればもっといける。

出力結果はこちら。

Sub Assign(Value As Variant, v1 As Variant, _
            Optional v2 As Variant, _
            Optional v3 As Variant, _
            Optional v4 As Variant, _
            Optional v5 As Variant, _
            Optional v6 As Variant, _
            Optional v7 As Variant, _
            Optional v8 As Variant, _
            Optional v9 As Variant, _
            Optional v10 As Variant, _
            Optional v11 As Variant, _
            Optional v12 As Variant, _
            Optional v13 As Variant, _
            Optional v14 As Variant, _
            Optional v15 As Variant, _
            Optional v16 As Variant, _
            Optional v17 As Variant, _
            Optional v18 As Variant, _
            Optional v19 As Variant, _
            Optional v20 As Variant)
    v1 = Value
    If IsMissing(v2) Then Exit Sub
    v2 = Value
    If IsMissing(v3) Then Exit Sub
    v3 = Value
    If IsMissing(v4) Then Exit Sub
    v4 = Value
    If IsMissing(v5) Then Exit Sub
    v5 = Value
    If IsMissing(v6) Then Exit Sub
    v6 = Value
    If IsMissing(v7) Then Exit Sub
    v7 = Value
    If IsMissing(v8) Then Exit Sub
    v8 = Value
    If IsMissing(v9) Then Exit Sub
    v9 = Value
    If IsMissing(v10) Then Exit Sub
    v10 = Value
    If IsMissing(v11) Then Exit Sub
    v11 = Value
    If IsMissing(v12) Then Exit Sub
    v12 = Value
    If IsMissing(v13) Then Exit Sub
    v13 = Value
    If IsMissing(v14) Then Exit Sub
    v14 = Value
    If IsMissing(v15) Then Exit Sub
    v15 = Value
    If IsMissing(v16) Then Exit Sub
    v16 = Value
    If IsMissing(v17) Then Exit Sub
    v17 = Value
    If IsMissing(v18) Then Exit Sub
    v18 = Value
    If IsMissing(v19) Then Exit Sub
    v19 = Value
    If IsMissing(v20) Then Exit Sub
    v20 = Value
End Sub

マクロにマクロを書かせるテクニックは当ブログでなんどか紹介しているが、力技でもこうしたテクニックを用いると実用的にメンテナンスできるので覚えておきたい。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。