在vba中创build一个全局variables数组数组，并转换为一个表
正在寻找解决scheme，但无法find一个很好的解释。
我目前有代码，每次迭代返回一个电子表格的行数组。 在最后一次迭代中，将所有行数据复制并粘贴到另一个表单中。 我知道，如果我可以制作一个庞大的arrays，每个项目是一组数据，然后转置它，而不需要复制和粘贴/操作单元格，那么速度会快一百万倍。
我怎样才能做到这一点？ 对我来说更大的问题是，每个主要迭代都是基于全局variables，而不是子本身内的循环。 这是因为用于为每个迭代创build数组的表单数据需要时间加载到表单中。
这是我的子代码。 到目前为止，你可以看到，在每一个写入数据的范围（“A”和POS），然后增加了工作表本身的计数器。 一旦子完成，全局variables迭代，并再次假设…所以简而言之，数组或数组将需要是一个全局variables
* 在任何人看起来和说F之前，我没有看所有的代码，唯一重要的部分是真的像最后10行…其他一切只是为了清晰起见。
Sub find_patternRevised() Application.ScreenUpdating = False Sheets("SingleEquityHistoryHedge").Activate Range("A47:M47").Clear Dim strt_pt() As Long Dim end_pt() As Long Dim i As Long Dim j As Long Dim k As Long Dim y As Long Dim pos As Long pos = Range("F1").value k = 0 For j = 8 To 12 i = 13 ' find start points for each column Do While Not IsNumeric(Cells(i, j).value) i = i + 1 Loop ReDim Preserve strt_pt(4) strt_pt(k) = i 'Debug.Print strt_pt(k) k = k + 1 Next j k = 0 i = 13 j = 8 ' finds patterns for each column Do While j <= 12 ' find start points for each column If Cells(strt_pt(k), j).value > 0 Then If Not IsNumeric(Cells(i, j)) Then i = i + 1 Else On Error Resume Next ' bypass error thrown by #VALUE 'loop until return sign changes or cell is blank Do Until Cells(i, j).value < 0 Or Cells(i, j).value = vbNullString i = i + 1 Loop ReDim Preserve end_pt(5) end_pt(y) = i 'Debug.Print end_pt(y) y = y + 1 j = j + 1 i = 13 'reset start after entering value End If ElseIf Cells(strt_pt(k), j).value < 0 Then If Not IsNumeric(Cells(i, j)) Then i = i + 1 Else On Error Resume Next Do Until Cells(i, j).value > 0 Or Cells(i, j).value = vbNullString i = i + 1 Loop ReDim Preserve end_pt(5) end_pt(y) = i 'Debug.Print end_pt(y) y = y + 1 j = j + 1 i = 13 ' reset start after entering value End If End If Loop Dim lent As Long Dim end_ct As Long end_ct = 0 Dim final_array() As Variant ReDim Preserve final_array(11) final_array(0) = Range("B2").value final_array(1) = Range("B3").value j = 8 For lent = 2 To 11 Step 1 If lent Mod 2 = 0 Then ReDim Preserve final_array(11) final_array(lent) = end_pt(end_ct) - strt_pt(end_ct) Else 'gets average over pattern period Dim avg_rng As Range Set avg_rng = Sheets("SingleEquityHistoryHedge").Range(Cells(strt_pt(end_ct), j), Cells(end_pt(end_ct) - 1, j)) Dim avg_value As Double avg_value = avgVal(avg_rng) ReDim Preserve final_array(11) final_array(lent) = avg_value end_ct = end_ct + 1 j = j + 1 End If Next lent Range("A" & pos).Resize(1, UBound(final_array) + 1) = final_array Sheets("SingleEquityHistoryHedge").Range("f1").value = pos + 1 End Sub
看起来你的数组只有一个维度。 你需要创build二维数组，填充它，然后你可以用一个语句把它写到表单中。
这里是一个例子，你显然需要根据你的需要来定制它（我说：“ F，我没有查看所有的代码!!! ”）
Sub foo() Dim arr(1 To 10, 1 To 5) 'creates an array 10 rows x 5 columns Dim x As Long Dim y As Long For x = LBound(arr, 1) To UBound(arr, 1) For y = LBound(arr, 2) To UBound(arr, 2) arr(x, y) = Application.WorksheetFunction.RandBetween(1, 100) Next Next 'Put it on the sheet: Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End Sub