インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

Excel VBA variant型の配列を二次元のセルに流し込むマクロ

表現が正しいのかちょっと悩みましたが,明日自分が職場についたら速攻やらないといけないことなので,事前に作ってみました。
以前はmodやら商を取ってごちゃごちゃ自分にしかわからない書き方をしてたんですが,シンプルに書けた気がします。

まずコード

Option Explicit
Sub test()
Dim arr As Variant
    arr = Split("1,2,3,4,5,6,7,8,9,10,11,12,13,14,15", ",")
    
    Tabular arr, ActiveSheet.Range("a1"), 6
    
    Tabular arr, ActiveSheet.Range("a10"), 4, 2, 2
End Sub


Sub Tabular(arr As Variant, 基準セル As Range, 列数 As Long, Optional 列差分 As Long = 1, Optional 行差分 As Long = 1)
    Dim minIndex As Long: minIndex = LBound(arr)
    Dim maxIndex As Long: maxIndex = UBound(arr)
    
    Dim i As Long, j As Long, k As Long
    j = 0: k = 0
    With 基準セル
        For i = minIndex To maxIndex
            .Offset(k * 行差分, j * 列差分) = arr(i)
            j = j + 1
            If j = 列数 Then
                j = 0
                k = k + 1
            End If
        Next
    End With
End Sub

私は区切り文字で区切った文字列を多用するので,それをvariantに放り込む処理から書いてみています。testを実行すると,
f:id:chemiphys:20170212225522p:plain
こんな感じになります。

事前に何か値があっても気にせずに実行しますので,事前にきれいにしておいてくださいね。

とても簡単に書いていると思いますので,動作は単純ですが,私はよくこういう処理をしないといけない場面に出会います。

一次配列とかもvariantにつっこんだら動くんじゃないかなぁと思います(゚▽゚*)

セル範囲を配列に放り込んだら必ず2次配列になったので,それをぱっと流すのはめんどくさそうだなぁ。余裕があったら今から考えます。。(;´▽`A``

追記 一応セル範囲を一次配列にするやつを作ってみました。

Function Arr1dfrom2d(arr As Variant, OptionalAs Long = 1, OptionalAs Long = 1) As Variant
    Dim 行数 As Long: 行数 = UBound(arr, 1) - LBound(arr, 1) + 1
    Dim 列数 As Long: 列数 = UBound(arr, 2) - LBound(arr, 2) + 1
    
    Dim TargetColumn As Long
    If 行数 <> 1 And 列数 <> 1 Then
        Dim ret As String
        ret = InputBox("何列目のデータを取得しますか?")
        If IsNumeric(ret) = False Then Exit Function
        TargetColumn = CLng(ret)
    ElseIf 行数 = 1 Then
        arr = WorksheetFunction.Transpose(arr)
        TargetColumn = 1
    ElseIf 列数 = 1 Then
        TargetColumn = 1
    End If
    
    
    Dim tmparr() As Variant: ReDim tmparr(1 To UBound(arr, 1))
    Dim i As Long
    For i = 1 To UBound(arr, 1)
        tmparr(i) = arr(i, TargetColumn)
    Next
    
    Arr1dfrom2d = tmparr
    
End Function

これを組み合わせると

Sub test()
Dim arr As Variant
    
    arr = Arr1dfrom2d(ActiveSheet.Range("n2:ad2").Value)
    'arr = Split("1,2,3,4,5,6,7,8,9,10,11,12,13,14,15", ",")
    
    Tabular arr, ActiveSheet.Range("a1"), 6
    
    Tabular arr, ActiveSheet.Range("a10"), 4, 2, 2
End Sub

こんな感じでセルの値を流し込めました。

ばたばた作ったので,配慮は足りないかもしれません。_(._.)_