Question

我不知道如何做到这一点所以任何帮助都会很棒。使用数组，我逐行发送到excel工作簿，它执行大量计算（太多无法编程）并吐出13个值，我想存储到另一个数组中。这可能吗？

Dim aP() as Variant
Dim wbR as Workbook
Dim wsR as Worksheet
Dim i as Long

Set wbR = Workbooks.Open([directory])
Set wsR = wbR.Sheets("Sheet1")
aP = Application.Transpose(Activesheet.Range("A1:Z100"))
For i = 1 to 100
wsR.Range("A1:A26") = Application.Index(aP, [row(1:26)], i)
'this is where I need help. Want to paste range C1:C13 into another array,
'so that I can paste it back into the activesheet. I do not wish to paste it 
'straight back to the worksheet, but accumulate all the data into array and 
'and then paste the array into the activesheet
Next i

Exit Sub

Answer 1

好像你正试图让你的代码超高效。我做了一些改变，可以加快速度。

Sub BuildArrayR100C26()
    Dim arData(99, 12)
    Dim arCalculations
    Dim i As Integer, j As Integer
    Dim wbR As Workbook
    Dim wsR As Worksheet

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set wbR = Workbooks.Open([directory])
    Set wsR = wbR.Sheets("Sheet1")
    For i = 0 To 99

        wsR.Range("A1:A26").Value = Application.Transpose(ActiveSheet.Range("A1:Z1").Offset(i))
        Application.Calculate

        arCalculations = wsR.Range("C1:C13").Cells(j + 1)

        For j = 0 To 12
            arData(i, j) = arCalculations(j + 1, 1)
        Next

    Next i
    Sheet2.Range("A1").Resize(UBound(arData, 1), UBound(arData, 2)).Value = arData
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

此行将范围一次粘贴到wsR一行。

wsR.Range（“A1：A26”）。Value = Application.Transpose（ActiveSheet.Range（“A1：Z1”）。Offset（i））

此循环将计算复制到数组

For j = 0 To 12
    arData(i, j) = wsR.Range("C1:C13").Cells(j + 1)
Next

关闭ScreenUpdating和计算

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

在我们粘贴要计算的新数据后重新计算

Application.Calculate

Excel VBA - 将新行写入现有数组

1 个答案: