VBAmacros的性能太慢了
我从两张工作表（Testfall-Input_Vorschlag）和（Testfall-Input_Antrag）中填写了另外一个工作表（ADMIN_ARB11）中的随机值。
我有工作表中的371行（Testfall-Input_Vorschlag）＆我有工作表中的488行（Testfall-Input_Antrag）
工作表（ADMIN_ARB11）中有859列。
我从第一列371列（从ADMIN_ARB11）中选取一个随机值，然后将它们放在表格中的371行（Testfall-Input_Vorschlag）中，然后从随后的488列（从ADMIN_ARB11）中select一个随机值，把它们放在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分钟来运行代码。 我怎样才能优化这个？
根据我的经验，直接写入单元是一个昂贵的过程。 相反，你可以设置一个形状类似你想要填充的范围，然后用你的值填充数组 ，最后把数组放入范围，例如
Dim vArr(1 To 300, 1 To 250) As Variant vArr(1, 1) = someValue
...
Range("A1:ZZ300") = vArr
通常这会加速90-95％。 你可以在这里find更多： http : //www.mrexcel.com/forum/excel-questions/71620-assign-range-cells-array.html
和这里： http : //www.cpearson.com/excel/ArraysAndRanges.aspx
速度的其他提示可以在这里find： http : //www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html