我从另一张(ADMIN_ARB11)中填写两张(Testfall-Input_Vorschlag)和(Testfall-Input_Antrag)的随机值。
我在表格中有371行(Testfall-Input_Vorschlag)& 我在表格中有488行(Testfall-Input_Antrag)
我在表格中有859列(ADMIN_ARB11)。
我从第一个371列(来自ADMIN_ARB11)中选择一个随机值,然后将它们放入工作表中的371行(Testfall-Input_Vorschlag)中,然后从接下来的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分钟。我该如何优化呢?
答案 0 :(得分:2)
根据我的经验,直接写入细胞是一个昂贵的过程。相反,您可以设置一个形状类似于您想要填充的范围的数组,然后使用您的值填充数组,最后将数组放入范围中,例如
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
答案 1 :(得分:1)