'---------------------------------------------------------------- ' 関 数 名:配列をセルに移送(横方向) ' 処理概要:配列をセルに横方向に書き込む ' 引 数: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