Question

以下VBA代码需要很长时间才能执行

Sub LOOK()

Worksheets("Input").Unprotect ("ds12345")
Dim found As Range
Set found = Sheets("Records").Columns("D").Find(What:=ActiveSheet.Cells(3, 13).Value, SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole)
If found Is Nothing Then
    MsgBox "Not found"
Else
    MsgBox "Found on row " & found.Row
End If

    Dim iRow As Integer

    iRow = InputBox("Which row?")

    Worksheets("Input").Cells(2, 1).Value = Worksheets("Records").Cells(iRow, 2).Value
    Worksheets("Input").Cells(4, 2).Value = Worksheets("Records").Cells(iRow, 3).Value
    Worksheets("Input").Cells(3, 13).Value = Worksheets("Records").Cells(iRow, 4).Value
    Worksheets("Input").Cells(4, 13).Value = Worksheets("Records").Cells(iRow, 5).Value
    Worksheets("Input").Cells(10, 3).Value = Worksheets("Records").Cells(iRow, 6).Value
    Worksheets("Input").Cells(3, 16).Value = Worksheets("Records").Cells(iRow, 7).Value
    Worksheets("Input").Cells(9, 7).Value = Worksheets("Records").Cells(iRow, 9).Value
    Worksheets("Input").Cells(12, 7).Value = Worksheets("Records").Cells(iRow, 10).Value
    Worksheets("Input").Cells(13, 7).Value = Worksheets("Records").Cells(iRow, 11).Value
    Worksheets("Input").Cells(9, 14).Value = Worksheets("Records").Cells(iRow, 12).Value
    Worksheets("Input").Cells(94, 5).Value = Worksheets("Records").Cells(iRow, 13).Value
    Worksheets("Input").Cells(95, 5).Value = Worksheets("Records").Cells(iRow, 14).Value
    Worksheets("Input").Cells(97, 2).Value = Worksheets("Records").Cells(iRow, 15).Value
    Worksheets("Input").Cells(20, 1).Value = Worksheets("Records").Cells(iRow, 16).Value
    Worksheets("Input").Cells(21, 1).Value = Worksheets("Records").Cells(iRow, 17).Value
    Worksheets("Input").Cells(22, 1).Value = Worksheets("Records").Cells(iRow, 18).Value
    Worksheets("Input").Cells(23, 1).Value = Worksheets("Records").Cells(iRow, 19).Value
    Worksheets("Input").Cells(24, 1).Value = Worksheets("Records").Cells(iRow, 20).Value
    Worksheets("Input").Cells(25, 1).Value = Worksheets("Records").Cells(iRow, 21).Value
    Worksheets("Input").Cells(26, 1).Value = Worksheets("Records").Cells(iRow, 22).Value
    Worksheets("Input").Cells(27, 1).Value = Worksheets("Records").Cells(iRow, 23).Value
    Worksheets("Input").Cells(28, 1).Value = Worksheets("Records").Cells(iRow, 24).Value
    Worksheets("Input").Cells(29, 1).Value = Worksheets("Records").Cells(iRow, 25).Value
    Worksheets("Input").Cells(30, 1).Value = Worksheets("Records").Cells(iRow, 26).Value
    Worksheets("Input").Cells(31, 1).Value = Worksheets("Records").Cells(iRow, 27).Value
    Worksheets("Input").Cells(32, 1).Value = Worksheets("Records").Cells(iRow, 28).Value
    Worksheets("Input").Cells(33, 1).Value = Worksheets("Records").Cells(iRow, 29).Value
    Worksheets("Input").Cells(34, 1).Value = Worksheets("Records").Cells(iRow, 30).Value
    Worksheets("Input").Cells(20, 11).Value = Worksheets("Records").Cells(iRow, 31).Value
    Worksheets("Input").Cells(21, 11).Value = Worksheets("Records").Cells(iRow, 32).Value
    Worksheets("Input").Cells(22, 11).Value = Worksheets("Records").Cells(iRow, 33).Value
    Worksheets("Input").Cells(23, 11).Value = Worksheets("Records").Cells(iRow, 34).Value
    Worksheets("Input").Cells(24, 11).Value = Worksheets("Records").Cells(iRow, 35).Value
    Worksheets("Input").Cells(42, 11).Value = Worksheets("Records").Cells(iRow, 37).Value
    Worksheets("Input").Cells(43, 11).Value = Worksheets("Records").Cells(iRow, 38).Value
    Worksheets("Input").Cells(44, 11).Value = Worksheets("Records").Cells(iRow, 39).Value
    Worksheets("Input").Cells(45, 11).Value = Worksheets("Records").Cells(iRow, 40).Value
    Worksheets("Input").Cells(46, 11).Value = Worksheets("Records").Cells(iRow, 41).Value
    Worksheets("Input").Cells(47, 11).Value = Worksheets("Records").Cells(iRow, 42).Value
    Worksheets("Input").Cells(48, 11).Value = Worksheets("Records").Cells(iRow, 43).Value
    Worksheets("Input").Cells(58, 5).Value = Worksheets("Records").Cells(iRow, 44).Value
    Worksheets("Input").Cells(59, 5).Value = Worksheets("Records").Cells(iRow, 45).Value
    Worksheets("Input").Cells(60, 5).Value = Worksheets("Records").Cells(iRow, 46).Value
    Worksheets("Input").Cells(58, 8).Value = Worksheets("Records").Cells(iRow, 47).Value
    Worksheets("Input").Cells(59, 8).Value = Worksheets("Records").Cells(iRow, 48).Value
    Worksheets("Input").Cells(60, 8).Value = Worksheets("Records").Cells(iRow, 49).Value
    Worksheets("Input").Cells(58, 11).Value = Worksheets("Records").Cells(iRow, 50).Value
    Worksheets("Input").Cells(59, 11).Value = Worksheets("Records").Cells(iRow, 51).Value
    Worksheets("Input").Cells(60, 11).Value = Worksheets("Records").Cells(iRow, 52).Value
    Worksheets("Input").Cells(58, 14).Value = Worksheets("Records").Cells(iRow, 53).Value
    Worksheets("Input").Cells(59, 14).Value = Worksheets("Records").Cells(iRow, 54).Value
    Worksheets("Input").Cells(60, 14).Value = Worksheets("Records").Cells(iRow, 55).Value
    Worksheets("Input").Cells(65, 18).Value = Worksheets("Records").Cells(iRow, 56).Value
    Worksheets("Input").Cells(104, 18).Value = Worksheets("Records").Cells(iRow, 76).Value

    If [l8] = [n9] Then
        [K8] = "YES"
        End If
    If [l9] = [n9] Then
        [K9] = "YES"
        End If
    If [l10] = [n9] Then
        [K10] = "YES"
        End If
    If [l12] = [n9] Then
        [K12] = "YES"
        End If
    If [l13] = [n9] Then
        [K13] = "YES"
        End If
    If [l14] = [n9] Then
        [K14] = "YES"
        End If
    If [l15] = [n9] Then
        [K15] = "YES"
        End If
    If [l16] = [n9] Then
        [K16] = "YES"
        End If
    If [l17] = [n9] Then
        [K17] = "YES"
    End If

Worksheets("Input").Protect ("ds12345")
End Sub

如果可以修改此代码以快速运行。或者，如果需要编写任何替代的VBA代码，以便从工作表“输入”快速运行，以从工作表“记录”中提取数据。感谢

Answer 1

我这样做的第一件事就是使用屏幕更新

来加速VBA

Sub LOOK()

Application.ScreenUpdating = False

Worksheets("Input").Unprotect ("ds12345")
Dim found As Range
Set found = Sheets("Records").Columns("D").Find(What:=ActiveSheet.Cells(3, 13).Value, SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole)
If found Is Nothing Then
    MsgBox "Not found"
Else
    MsgBox "Found on row " & found.Row
End If

Dim iRow As Integer

iRow = InputBox("Which row?")

Worksheets("Input").Cells(2, 1).Value = Worksheets("Records").Cells(iRow, 2).Value
Worksheets("Input").Cells(4, 2).Value = Worksheets("Records").Cells(iRow, 3).Value
Worksheets("Input").Cells(3, 13).Value = Worksheets("Records").Cells(iRow, 4).Value
Worksheets("Input").Cells(4, 13).Value = Worksheets("Records").Cells(iRow, 5).Value
Worksheets("Input").Cells(10, 3).Value = Worksheets("Records").Cells(iRow, 6).Value
Worksheets("Input").Cells(3, 16).Value = Worksheets("Records").Cells(iRow, 7).Value
Worksheets("Input").Cells(9, 7).Value = Worksheets("Records").Cells(iRow, 9).Value
Worksheets("Input").Cells(12, 7).Value = Worksheets("Records").Cells(iRow, 10).Value
Worksheets("Input").Cells(13, 7).Value = Worksheets("Records").Cells(iRow, 11).Value
Worksheets("Input").Cells(9, 14).Value = Worksheets("Records").Cells(iRow, 12).Value
Worksheets("Input").Cells(94, 5).Value = Worksheets("Records").Cells(iRow, 13).Value
Worksheets("Input").Cells(95, 5).Value = Worksheets("Records").Cells(iRow, 14).Value
Worksheets("Input").Cells(97, 2).Value = Worksheets("Records").Cells(iRow, 15).Value
Worksheets("Input").Cells(20, 1).Value = Worksheets("Records").Cells(iRow, 16).Value
Worksheets("Input").Cells(21, 1).Value = Worksheets("Records").Cells(iRow, 17).Value
Worksheets("Input").Cells(22, 1).Value = Worksheets("Records").Cells(iRow, 18).Value
Worksheets("Input").Cells(23, 1).Value = Worksheets("Records").Cells(iRow, 19).Value
Worksheets("Input").Cells(24, 1).Value = Worksheets("Records").Cells(iRow, 20).Value
Worksheets("Input").Cells(25, 1).Value = Worksheets("Records").Cells(iRow, 21).Value
Worksheets("Input").Cells(26, 1).Value = Worksheets("Records").Cells(iRow, 22).Value
Worksheets("Input").Cells(27, 1).Value = Worksheets("Records").Cells(iRow, 23).Value
Worksheets("Input").Cells(28, 1).Value = Worksheets("Records").Cells(iRow, 24).Value
Worksheets("Input").Cells(29, 1).Value = Worksheets("Records").Cells(iRow, 25).Value
Worksheets("Input").Cells(30, 1).Value = Worksheets("Records").Cells(iRow, 26).Value
Worksheets("Input").Cells(31, 1).Value = Worksheets("Records").Cells(iRow, 27).Value
Worksheets("Input").Cells(32, 1).Value = Worksheets("Records").Cells(iRow, 28).Value
Worksheets("Input").Cells(33, 1).Value = Worksheets("Records").Cells(iRow, 29).Value
Worksheets("Input").Cells(34, 1).Value = Worksheets("Records").Cells(iRow, 30).Value
Worksheets("Input").Cells(20, 11).Value = Worksheets("Records").Cells(iRow, 31).Value
Worksheets("Input").Cells(21, 11).Value = Worksheets("Records").Cells(iRow, 32).Value
Worksheets("Input").Cells(22, 11).Value = Worksheets("Records").Cells(iRow, 33).Value
Worksheets("Input").Cells(23, 11).Value = Worksheets("Records").Cells(iRow, 34).Value
Worksheets("Input").Cells(24, 11).Value = Worksheets("Records").Cells(iRow, 35).Value
Worksheets("Input").Cells(42, 11).Value = Worksheets("Records").Cells(iRow, 37).Value
Worksheets("Input").Cells(43, 11).Value = Worksheets("Records").Cells(iRow, 38).Value
Worksheets("Input").Cells(44, 11).Value = Worksheets("Records").Cells(iRow, 39).Value
Worksheets("Input").Cells(45, 11).Value = Worksheets("Records").Cells(iRow, 40).Value
Worksheets("Input").Cells(46, 11).Value = Worksheets("Records").Cells(iRow, 41).Value
Worksheets("Input").Cells(47, 11).Value = Worksheets("Records").Cells(iRow, 42).Value
Worksheets("Input").Cells(48, 11).Value = Worksheets("Records").Cells(iRow, 43).Value
Worksheets("Input").Cells(58, 5).Value = Worksheets("Records").Cells(iRow, 44).Value
Worksheets("Input").Cells(59, 5).Value = Worksheets("Records").Cells(iRow, 45).Value
Worksheets("Input").Cells(60, 5).Value = Worksheets("Records").Cells(iRow, 46).Value
Worksheets("Input").Cells(58, 8).Value = Worksheets("Records").Cells(iRow, 47).Value
Worksheets("Input").Cells(59, 8).Value = Worksheets("Records").Cells(iRow, 48).Value
Worksheets("Input").Cells(60, 8).Value = Worksheets("Records").Cells(iRow, 49).Value
Worksheets("Input").Cells(58, 11).Value = Worksheets("Records").Cells(iRow, 50).Value
Worksheets("Input").Cells(59, 11).Value = Worksheets("Records").Cells(iRow, 51).Value
Worksheets("Input").Cells(60, 11).Value = Worksheets("Records").Cells(iRow, 52).Value
Worksheets("Input").Cells(58, 14).Value = Worksheets("Records").Cells(iRow, 53).Value
Worksheets("Input").Cells(59, 14).Value = Worksheets("Records").Cells(iRow, 54).Value
Worksheets("Input").Cells(60, 14).Value = Worksheets("Records").Cells(iRow, 55).Value
Worksheets("Input").Cells(65, 18).Value = Worksheets("Records").Cells(iRow, 56).Value
Worksheets("Input").Cells(104, 18).Value = Worksheets("Records").Cells(iRow, 76).Value

If [l8] = [n9] Then
    [K8] = "YES"
    End If
If [l9] = [n9] Then
    [K9] = "YES"
    End If
If [l10] = [n9] Then
    [K10] = "YES"
    End If
If [l12] = [n9] Then
    [K12] = "YES"
    End If
If [l13] = [n9] Then
    [K13] = "YES"
    End If
If [l14] = [n9] Then
    [K14] = "YES"
    End If
If [l15] = [n9] Then
    [K15] = "YES"
    End If
If [l16] = [n9] Then
    [K16] = "YES"
    End If
If [l17] = [n9] Then
    [K17] = "YES"
End If

Worksheets("Input").Protect ("ds12345")

Application.ScreenUpdating = True

End Sub

为了清洁代码，当你有很多逐渐增加的值时，我会做二次循环，如：

Worksheets("Input").Cells(42, 11).Value = Worksheets("Records").Cells(iRow, 37).Value
Worksheets("Input").Cells(43, 11).Value = Worksheets("Records").Cells(iRow, 38).Value
Worksheets("Input").Cells(44, 11).Value = Worksheets("Records").Cells(iRow, 39).Value 
Worksheets("Input").Cells(45, 11).Value = Worksheets("Records").Cells(iRow, 40).Value
Worksheets("Input").Cells(46, 11).Value = Worksheets("Records").Cells(iRow, 41).Value
Worksheets("Input").Cells(47, 11).Value = Worksheets("Records").Cells(iRow, 42).Value
Worksheets("Input").Cells(48, 11).Value = Worksheets("Records").Cells(iRow, 43).Value

我们没有这些数据，因此很难说是否有更有效的选择方式，但我认为使用复制和粘贴特殊值对于大多数情况来说会更快。

Answer 2

每次读取和写入Excel单元格都会带来巨大的负担。通过将Range的数组副本复制到数组，然后将数组分配回范围，可以快速复制到范围或从范围复制的性能提高30到100倍。

只是一张图片，但这里是一个实例的例子，即使禁用屏幕更新后，性能也会因为＆gt;而得到改善。使用逐个单元复制的阵列复制实例30次：

VBA代码需要很长时间才能在excel中执行

2 个答案: