excel - VBA 宏性能太慢

Question

我从另一张表 (ADMIN_ARB11) 中填写了两张表 (Testfall-Input_Vorschlag) 和 (Testfall-Input_Antrag) 中的随机值。

我在工作表中有 371 行 (Testfall-Input_Vorschlag) &
我在工作表中有 488 行(Testfall-Input_Antrag)

我在工作表中有 859 列(ADMIN_ARB11)。

我从第 371 列(来自 ADMIN_ARB11)中的每一列中选择一个随机值，并将它们放在工作表(Testfall-Input_Vorschlag)的 371 行中，然后从接下来的 488 列中的每一列中选择一个随机值(来自 ADMIN_ARB11)和将它们放在工作表中的 488 行中(Testfall-Input_Antrag)。为了实现这一点，我制定了一个代码。

Sub Random_Befüllung_Vorschlag_ARB11()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long, LB As Long, UB As Long
Set sh1 = Sheets("Testfall-Input_Vorschlag")
Set sh2 = Sheets("ADMIN_ARB11")


Application.ScreenUpdating = False
    For j = 7 To 300
        LB = 2
        If sh1.Cells(1, j) = "ARB11" Or sh1.Cells(1, j) = "ARB13" Or sh1.Cells(1, j) = "FVB1" Or sh1.Cells(1, j) = "FVB1E" Or sh1.Cells(1, j) = "FVB4" Or sh1.Cells(1, j) = "FVB4E" Then
            sh1.Cells(2, j) = sh1.Cells(1, j) & "_Schicht 1"
            sh1.Cells(3, j) = "TPL maximale Eingaben"
            If j = 7 Then
                sh1.Cells(6, j) = 1
            Else
                sh1.Cells(6, j) = sh1.Cells(6, j - 1) + 1
            End If
            sh1.Cells(5, j) = "TF " & sh1.Cells(6, j)
            sh1.Cells(7, j) = "Test_GE"
            sh1.Cells(8, j) = "x"


            For i = 11 To 382
            UB = sh2.Cells(Rows.Count, i - 10).End(xlUp).Row 'i - 10 controls column in Admin start at col 1.

            sh1.Cells(i, j).Value = sh2.Cells(Int((UB - LB + 1) * Rnd + LB), i - 10)

            Next

        End If



    If sh1.Cells(1, j) = vbNullString Then
    Exit For
    End If
    Next
Application.ScreenUpdating = False
End Sub

Sub Random_Befüllung_Antrag_ARB11()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long, LB As Long, UB As Long
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("Testfall-Input_Vorschlag")
Set sh1 = Sheets("Testfall-Input_Antrag")
Set sh2 = Sheets("ADMIN_ARB11")


Application.ScreenUpdating = False
    'Testfallinfo in Testfall-Input_Antrag kopieren
    For j = 7 To 300
    If Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB11" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB13" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB1" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB1E" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB4" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB4E" Then
    Union(ws.Cells(1, j), ws.Cells(2, j), ws.Cells(3, j), ws.Cells(4, j), ws.Cells(5, j), ws.Cells(6, j), ws.Cells(7, j), ws.Cells(8, j)).Copy
    sh1.Range("IV1").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
    End If



        LB = 2
        If sh1.Cells(1, j) = "ARB11" Then
            For i = 13 To 501
                UB = sh2.Cells(Rows.Count, i + 364).End(xlUp).Row 'i - 10 controls column in Admin start at col 1.
                sh1.Cells(i, j).Value = sh2.Cells(Int((UB - LB + 1) * Rnd + LB), i + 364)


            Next
        End If

    If sh1.Cells(1, j) = vbNullString Then
    Exit For
    End If
    Next j
Application.ScreenUpdating = True
End Sub

它按预期工作，但运行代码需要 5 分钟。我该如何优化呢？

Answer 1

根据我的经验，直接写入单元格是一个昂贵的过程。相反，您可以 设置一个形状像您要填充的范围的数组，然后填充数组使用您的值，最后将数组放入范围，例如

Dim vArr(1 To 300, 1 To 250) As Variant

vArr(1, 1) = someValue

...

Range("A1:ZZ300") = vArr

通常这会加快 90-95% 的速度。您可以在这里找到更多信息: http://www.mrexcel.com/forum/excel-questions/71620-assign-range-cells-array.html

和这里:
http://www.cpearson.com/excel/ArraysAndRanges.aspx