0

正在寻找解决方案，但找不到很好的解释。

我目前有代码将每次迭代的数组返回到电子表格的一行中。在最后一次迭代中，它获取所有行数据并将其复制并粘贴到另一张纸上。我知道如果我可以创建一个巨大的数组，每个项目都是一个数据数组，然后转置它而不复制和粘贴/操作单元格，那将快一百万倍。

我怎样才能做到这一点？对我来说更大的问题是每次主要迭代都基于一个全局变量，而不是 sub 本身的循环。这是因为用于为每次迭代制作数组的工作表数据需要时间才能加载到工作表中。

这是我的子代码。到目前为止，您可以看到在每次写入数据时，Range("A" & pos) 会增加工作表本身的计数器。一旦子完成，全局变量迭代并再次假设......所以简而言之，一个或多个数组需要是一个全局变量

*在任何人查看并说 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

4

1 回答 1

2

看起来您的数组只是一维的。您需要创建二维数组，将其全部填充，然后您可以使用单个语句将其写入工作表。

这是一个示例，您显然需要根据自己的需要对其进行定制（我说“ 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
于 2013-09-28T04:02:22.023 回答