Question

我已经做了很多搜索以尝试优化此代码。我已经大大减少了运行时间，但我似乎无法找到其他任何东西（注意：我已经完成了所有xlcalculationmanual和screenupdating = false jazz）

这是我当前循环的基本结构。矩阵当前是5行，数据循环，9遍。

Application.Calculation = xlCalculationManual
i = 0
Do While wsc1.Cells(10, i + 65) <> "things" And wsc1.Cells(10, i + 65) <> "thing2" And wsc1.Cells(10, i + 65) <> ""
    j = 0
    Do While wsc1.Cells(j + 11, 64) <> ""
        wsc.Cells(109, 3) = wsc1.Cells(j + 11, 64)    'rows
        wsc.Cells(109, 6) = wsc1.Cells(10, i + 65)    'columns
        Application.Calculation = xlCalculationAutomatic
        Application.Calculation = xlCalculationManual
        wsc1.Cells(j + 11, i + 65) = wsc.Range("O6")    'Print
        j = j + 1
    Loop
    i = i + 1
Loop

我认为我的下一个最佳选择是将列/行向量存储为变量并循环显示？

谢谢

Answer 1

你还可以添加这些行吗？

Application.EnableEvents = False
Application.ScreenUpdating = False ' it seems that you already have this one?

Answer 2

试一试。但是，不得不等待工作表计算是一个相当困难的减速，如果我们不能将计算放在代码中，那么除此之外真的没有太多可以做的来提高性能。

Sub tgr()

    Dim wsc1 As Worksheet
    Dim CValues As Variant
    Dim FValues As Variant
    Dim Results() As Variant
    Dim i As Long, j As Long
    Dim xlCalc As XlCalculation

    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    On Error GoTo CleanExit

    Set wsc1 = ActiveWorkbook.ActiveSheet
    With wsc1.Range("BL11", wsc1.Cells(wsc1.Rows.Count, "BL").End(xlUp))
        If .Row < 11 Then Exit Sub 'No data
        If .Cells.Count = 1 Then
            ReDim CValues(1 To 1, 1 To 1)
            CValues(1, 1) = .Value
        Else
            CValues = .Value
        End If
    End With

    With wsc1.Range("BM10", wsc1.Cells(10, wsc1.Columns.Count).End(xlToLeft))
        If .Column < Columns("BM").Column Then Exit Sub 'No data
        If .Cells.Count = 1 Then
            ReDim FValues(1 To 1, 1 To 1)
            FValues(1, 1) = .Value
        Else
            FValues = .Value
        End If
    End With

    ReDim Results(1 To UBound(CValues, 1), 1 To UBound(FValues, 2))

    For i = LBound(CValues, 1) To UBound(CValues, 1)
        For j = LBound(FValues, 2) To UBound(FValues, 2)
            wsc1.Range("C109").Value = CValues(i, 1)
            wsc1.Range("F109").Value = FValues(1, j)
            wsc1.Calculate
            Results(i, j) = wsc1.Range("O6").Value
        Next j
    Next i

    wsc1.Range("BM11").Resize(UBound(Results, 1), UBound(Results, 2)).Value = Results

CleanExit:
    With Application
        .Calculation = xlCalc
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

循环遍历包含多个列和行的数组

2 个答案: