Question

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

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

**geo.distance(location, geography'POINT(-122.131577 47.678581)') asc**

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一维数组输出从水平改为垂直？

2 个答案:

二维一列一基数组