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

我需要执行以下操作：

• 将范围C2：AU264提升到二维arrays
• 创build另一个1D数组，（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是variables，则budgets = Ws.Range("C2:AU265")将自动设置范围（左上方的单元格（在这种情况下，C2）将是(1, 1) ）。

编辑

假设你只想写下所有的列（一个接一个地），你可以缩小这个macros：

 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... -lines。 （仍然像以前一样的代码基本相同）