VBA宏性能太慢 [英] VBA Macro performance is too slow
问题描述
我在另一张纸(ADMIN_ARB11)的两张纸(Testfall-Input_Vorschlag)和(Testfall-Input_Antrag)中填写随机值.
I fill out Random values in two sheets (Testfall-Input_Vorschlag) and (Testfall-Input_Antrag) out of another sheet (ADMIN_ARB11).
工作表中有371行(Testfall-Input_Vorschlag)&我的工作表中有488行(Testfall-Input_Antrag)
I have 371 rows in sheet (Testfall-Input_Vorschlag) & I have 488 rows in sheet (Testfall-Input_Antrag)
工作表(ADMIN_ARB11)中有859列.
I have 859 columns in sheet (ADMIN_ARB11).
我从前371列的每一行中选择一个随机值(来自ADMIN_ARB11),然后将它们放在工作表的371行中(Testfall-Input_Vorschlag),然后从接下来的488列的每一行中选择一个随机值(来自ADMIN_ARB11),然后将它们放在表中的488行中(Testfall-Input_Antrag).为此,我制定了代码.
I pick a random value from each of the 1st 371 columns(from ADMIN_ARB11) and I put them in the 371 rows in sheet (Testfall-Input_Vorschlag) and then I pick a random value from each of the next 488 columns(from ADMIN_ARB11) and put them in 488 rows in sheet (Testfall-Input_Antrag). To achieve this I have formulated a code.
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分钟才能运行代码.我该如何优化呢?
It works as expected but it takes 5 min to run the code. How can I optimize this?
推荐答案
以我的经验,直接写入单元格是一个昂贵的过程.相反,您可以设置形状像要填充的范围的数组,然后用值填充数组,最后将数组放入范围内,例如
In my experience, writing to cells directly is an expensive procedure. Instead, you could set up an array shaped like the range you want to fill, then fill the array with your values, and finally put the array into the range, e.g.
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
Usually this speeds things up by 90-95%. You can find out more here: http://www.mrexcel.com/forum/excel-questions/71620-assign-range-cells-array.html
在这里: http://www.cpearson.com/excel/ArraysAndRanges.aspx
这篇关于VBA宏性能太慢的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!