ちょっと生きづらさを抱えた人へ、気持ちを楽にするためのお手紙です。

【VBA】多次元配列をセルに一気に書き込む

'----------------------------------------------------------------
' 関 数 名:配列をセルに移送(横方向)
' 処理概要:配列をセルに横方向に書き込む
' 引    数:sh As Worksheet   ワークシートオブジェクト
'          startRow As Long  書き込み行
'          startCol As Long  書き込み列
'          arr() As String   書き込む配列
' 返 却 値:次の書き込み行
'----------------------------------------------------------------
Function transferArrayToCellHorizon( _
    sh As Worksheet, startRow As Long, startCol As Long, arr() As String) As Long
    Dim endRow As Long
    Dim endCol As Long
    
    endRow = startRow + UBound(arr, 2)
    endCol = UBound(arr) + 1
    sh.Range(sh.Cells(startRow, startCol), sh.Cells(endRow, endCol)).Value = _
        WorksheetFunction.Transpose(arr)
    
    transferArrayToCellHorizon = endRow + 1
End Function

'----------------------------------------------------------------
' 関 数 名:配列をセルに移送(縦方向)
' 処理概要:配列をセルに横方向に書き込む
' 引    数:sh As Worksheet   ワークシートオブジェクト
'          startRow As Long  書き込み行
'          startCol As Long  書き込み列
'          arr() As String   書き込む配列
' 返 却 値:次の書き込み行
'----------------------------------------------------------------
Function transferArrayToCellVertical( _
    sh As Worksheet, startRow As Long, startCol As Long, arr() As String) As Long
    
    Dim endRow As Long
    Dim endCol As Long
    endRow = startRow + UBound(arr)
    endCol = UBound(arr, 2) + 1

    sh.Range(sh.Cells(startRow, startCol), sh.Cells(endRow, endCol)).Value = arr
    
    transferArrayToCellVertical = endRow + 1
End Function
Sub main()
    Dim sh As Worksheet
    Dim arr(3, 1) As String
    Dim nextRow As Long
    Dim i As Long
    
    arr(0, 0) = "1"
    arr(1, 0) = "2"
    arr(2, 0) = "3"
    arr(3, 0) = "4"
    arr(0, 1) = "5"
    arr(1, 1) = "6"
    arr(2, 1) = "7"
    arr(3, 1) = "8"
    
    Set sh = ThisWorkbook.Worksheets(1)
    nextRow = 1
    For i = 0 To 8
        nextRow = transferArrayToCellHorizon(sh, nextRow, 1, arr)
    Next i
    Set sh = Nothing
End Sub

 

コメントを残す

メールアドレスが公開されることはありません。