VBA代码不会将数组写入范围，只有第一个元素

Question

我需要做以下事情：

• 将范围 C2:AU264 提升为二维数组
• 创建另一个一维数组，（1 到 11880）
• 用第一个数组中的值填充第二个数组（“转置”）
• 将数组 2 写回工作表

这是我正在使用的代码：

Private Ws As Worksheet
Private budgets() As Variant
Private arrayToWrite() As Variant
Private lastrow As Long
Private lastcol As Long

Private Sub procedure()
Application.ScreenUpdating = False

Set Ws = Sheet19
Ws.Activate

lastrow = Ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).row
lastcol = Ws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column

ReDim budgets(1 To lastrow - 1, 1 To lastcol - 2)
budgets= Ws.Range("C2:AU265")

ReDim arrayToWrite(1 To (lastCol - 2) * (lastRow - 1))

k = 0
For j = 1 To UBound(budgets, 2)
    For i = 1 To UBound(budgets, 1)
      arrayToWrite(i + k) = budgets(i, j)
    Next i
    k = k + lastrow - 1
Next j


Set Ws = Sheet6
Ws.Activate

Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = arrayToWrite


'For i = 1 To UBound(arrayToWrite)
    'Ws.Range(Cells(i + 1, 5).Address).Value = arrayToWrite(i)
'Next i

Application.ScreenUpdating = True
End Sub

这只是从范围 C2:AU264（第一个数组的第一个元素）到整个范围 E2:E11881 写入第一个值。但是，如果我在脚本结束之前取消注释 For 循环并这样做，它确实有效，但速度很慢。如何使用第一条语句正确写入数组？

Answer 1

如果要将数组写入范围，则数组必须具有二维。即使你只想写一列。

改变

ReDim arrayToWrite(1 To (lastCol - 2) * (lastRow - 1))

到

ReDim arrayToWrite(1 To (lastCol - 2) * (lastRow - 1), 1 To 1)

和

arrayToWrite(i + k) = budgets(i, j)

到

arrayToWrite(i + k, 1) = budgets(i, j)

Answer 2

只需使用转置...改变

Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = arrayToWrite

到

Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = Application.Transpose(arrayToWrite)

提示：不需要ReDim budgets(1 To lastrow - 1, 1 To lastcol - 2)。
如果budgets 是一个变体，那么budgets = Ws.Range("C2:AU265") 将自动设置范围（左上角单元格（在本例中为C2）将为(1, 1)）。

编辑

假设你只想写下所有列（一个接一个），你可以像这样缩短宏：

Private Sub procedure()

  Dim inArr As Variant, outArr() As Variant
  Dim i As Long, j As Long, k As Long

  With Sheet19
    .Activate
    inArr = .Range(, .Cells(2, 3), .Cells(.Cells.Find("*", , , , 1, 2).Row, .Cells.Find("*", , , , 2, 2).Column)).Value
  End With

  ReDim outArr(1 To UBound(inArr) * UBound(inArr, 2))
  k = 1

  For j = 1 To UBound(inArr, 2)
    For i = 1 To UBound(inArr)
      k = k + 1
      arrayToWrite(k) = budgets(i, j)
    Next i
  Next j

  Sheet6.Range("E2:E" & UBound(arrayToWrite)).Value = Application.Transpose(arrayToWrite)

End Sub

如果您希望每一行相互转置，而不是简单地切换两个For...-行。 （代码还是和以前基本一样）