如何将VBA一维数组输出从水平变为垂直？

Question

在下面的 VBA 子例程中，我生成了一个随机数数组 ("ArrSim")，该数组大小为 10 行 x 3 列。当运行子时，此数组将粘贴到活动工作表的单元格 A1:C10 中。然后我生成另一个数组（“ArrRowAvg”），其中为 ArrSim 数组的每一行计算平均值。这很好用。第二个数组 ArrRowAvg 的结果水平粘贴到工作表中的 E1:N1.

单元格中

如何更改代码以便将 ArrRowAvg 垂直粘贴，始终在 ArrSim 数组右侧粘贴两列？为了简单起见，下面的代码是缩写的，一些输入变量是硬编码的；在完整代码中，用户输入所需的 ArrSim 大小。我只需要知道如何使 ArrRowAvg 垂直粘贴。我摆弄了转置和索引函数，但运气不好。

Sub Testing()

'   Clear contents of active worksheet and move cursor to Cell A1
    Cells.Clear
    Range("A1").Select

'   Declarations of variables and arrays
    Dim i As Long, j As Integer
    Dim ArrSim() As Double
    Dim OutputSim As Range
     
'   Redimension array
    ReDim ArrSim(1 To 10, 1 To 3)
   
'   Set worksheet range
    Set OutputSim = ActiveCell.Range(Cells(1, 1), Cells(10, 3))
  
'   Fill ArrSim with random values
    For i = 1 To 10
        For j = 1 To 3
            ArrSim(i, j) = Application.RandBetween(0, 100)
        Next j
    Next i

'   Transfer ArrSim to Worksheet
    OutputSim.Value = ArrSim

'   Generate 1-dimensional array to store the row averages
    Dim ArrRowAvg, ArrRow
    ReDim ArrRowAvg(10 - 1)
        
'   Loop to calculate row averages from above ArrSim and feed into new array
    For i = 0 To UBound(ArrSim, 1) - 1
        ArrRow = Application.Index(ArrSim, i + 1, 0)
        ArrRowAvg(i) = WorksheetFunction.Average(ArrRow)
    Next i

'   Paste the array ArrRowAvg values starting one column to the right of OutputSim
    OutputSim.Offset(0, 1 + OutputSim.Columns.Count).Resize(1, UBound(ArrRowAvg) + 1).Value = ArrRowAvg
        
End Sub

Answer 1

请使用此代码行：

OutputSim.Offset(0, 1 + OutputSim.Columns.count).Resize(UBound(ArrRowAvg) + 1, 1).Value = Application.Transpose(ArrRowAvg)

而不是：

OutputSim.Offset(0, 1 + OutputSim.Columns.Count).Resize(1, UBound(ArrRowAvg) + 1).Value = ArrRowAvg

Answer 2

二维一列一基数组

快速修复

Option Explicit

Sub Testing()

    Const FirstCell As String = "A1"
    Const rCount As Long = 10
    Const cCount As Long = 3

'   Clear contents of active worksheet and move cursor to Cell A1
    Cells.Clear
    Dim cel As Range: Set cel = Range(FirstCell)
    cel.Select

'   Declarations of variables and arrays
    Dim i As Long, j As Long
    Dim ArrSim() As Long
    Dim OutputSim As Range
     
'   Redimension array
    ReDim ArrSim(1 To rCount, 1 To cCount)
   
'   Fill ArrSim with random values
    For i = 1 To rCount
        For j = 1 To cCount
            ArrSim(i, j) = Application.RandBetween(0, 100)
        Next j
    Next i

'   Set worksheet range
    Set OutputSim = cel.Resize(rCount, cCount)

'   Transfer ArrSim to Worksheet
    OutputSim.Value = ArrSim

'   Generate 2-dimensional array to store the row averages
    Dim ArrRowAvg() As Double
    Dim ArrRow As Variant
    ReDim ArrRowAvg(1 To rCount, 1 To 1)
        
'   Loop to calculate row averages from above ArrSim and feed into new array
    For i = 1 To rCount
        ArrRow = Application.Index(ArrSim, i, 0)
        ArrRowAvg(i, 1) = Application.Average(ArrRow)
    Next i

'   Paste the array ArrRowAvg values starting one column to the right of OutputSim
    OutputSim.Columns(1).Offset(, cCount).Value = ArrRowAvg
        
End Sub

我的选择

Sub myChoice()

    ' Constants
    Const FirstCell As String = "A1"
    Const rCount As Long = 10
    Const cCount As Long = 3

    ' Arrays    
    Dim tcCount As Long: tcCount = cCount + 1
    Dim Data() As Double: ReDim Data(1 To rCount, 1 To tcCount)
    Dim DataRow As Variant
    Dim i As Long, j As Long
    For i = 1 To rCount
        For j = 1 To cCount
            Data(i, j) = Application.RandBetween(0, 100)
        Next j
        DataRow = Application.Index(Data, i, 0)
        Data(i, tcCount) = Application.Sum(DataRow) / cCount
    Next I

    ' Worksheet    
    Application.ScreenUpdating = False
    Cells.Clear
    With Range(FirstCell)
        .Select
        .Resize(rCount, tcCount).Value = Data
    End With
    Application.ScreenUpdating = True
    
End Sub

如何将VBA一维数组输出从水平变为垂直？

How to change VBA one-dimensional array output from horizontal to vertical?

arrays

excel

vba

vertical-alignment

二维一列一基数组