Question

请您协助我更有效地编写以下代码？我正在处理“主列表”，在该列表中，我每个月将来自各种来源的数据复制到Z，AC，AF，AI等列中（始终由2列分隔）。然后，我一直复制该单元格以更新每一行的值。正如您在下面的代码中看到的，从代码的一个部分到下一个部分的唯一区别是：

更改列（此处从Z更改为AC）
更改存储在不同单元格中的路径（例如fromPath更改为fromPath2。

如何提高效率？任何想法将不胜感激。

保重

' Update Jan 2018

fromPath = Sheets("Filepaths for P25 2017").Range("G2")
vbaPath = Sheets("Filepaths for P25 2017").Range("F2")
vbaFile = Sheets("Filepaths for P25 2017").Range("H2")
Orderlist2017 = Sheets("Filepaths for P25 2017").Range("I2")

With ThisWorkbook.Sheets("Orderlist P25 2017")
Range("Z10").Formula = "=VLookup(C10,  '" & vbaPath & vbaFile & Orderlist2017 & "'!C14:Z90, 8, False)"
Range("Z10").Select
    Selection.Copy
    Range("Y10").Select
    Selection.End(xlDown).Select
    Range("Z85").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

End With

' Update Feb 2018

fromPath2 = Sheets("Filepaths for P25 2017").Range("G3")
vbaPath2 = Sheets("Filepaths for P25 2017").Range("F3")
vbaFile2 = Sheets("Filepaths for P25 2017").Range("H3")
Orderlist2017 = Sheets("Filepaths for P25 2017").Range("I3")

With ThisWorkbook.Sheets("Orderlist P25 2017")
Range("AC10").Formula = "=VLookup(C10,  '" & vbaPath2 & vbaFile2 & Orderlist2017 & "'!C14:Z90, 8, False)"
Range("AC10").Select
    Selection.Copy
    Range("Y10").Select
    Selection.End(xlDown).Select
    Range("AC85").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

End With

Answer 1

以我的经验，加速大多数宏的最有效方法是关闭屏幕更新。另外，如果您的工作表中包含很多公式，则关闭自动计算会很有帮助。我创建了一个称为“ FastMode”的方法来执行此操作，该方法将在我创建的每个VBA项目中使用。在宏的顶部，将参数设置为“ True”以调用它，以使您的代码快速运行，然后最后，以“ False”调用，以恢复默认的Excel设置。

Public Sub FastMode(ByVal blnMode As Boolean)

  'set workbook to fast mode (or back to normal mode) to speed up any process
  'that modifies the worksheets

   On Error Resume Next

   With Application

      Select Case blnMode
         Case True
           .ScreenUpdating = False
           .Calculation = xlCalculationManual

         Case False
           .ScreenUpdating = True
           .Calculation = xlCalculationAutomatic

      End Select

   End With

End Sub

Answer 2

尝试类似这样的方法。未经测试，但可以帮助您入门。

Sub TT()

    Dim fromPath, vbaPath, vbaFile, Orderlist2017
    Dim shtPaths As Worksheet, shtOrders As Worksheet
    Dim i As Long, rngFormula

    Set shtPaths = Sheets("Filepaths for P25 2017") 'ThisWorkbook?
    Set shtOrders = ThisWorkbook.Sheets("Orderlist P25 2017")

    Set rngFormula = shtOrders.Range("Z10") '<< first vlookup goes here

    For i = 1 To 12 'for example...

        fromPath = shtPaths.Range("G2").Offset(i - 1, 0).Value
        vbaPath = shtPaths.Range("F2").Offset(i - 1, 0).Value
        vbaFile = shtPaths.Range("H2").Offset(i - 1, 0).Value
        Orderlist2017 = shtPaths.Range("I2").Offset(i - 1, 0).Value

        'you can assign the formula directly to the required range
        ' (exactly what you want here is not clear from your posted code...)
        rngFormula.Resize(76, 1).Formula = "=VLookup(C10,  '" & vbaPath & vbaFile & Orderlist2017 & "'!C$14:Z$90, 8, False)"

        Set rngFormula = rngFormula.Offset(0, 2) 'move over two columns

    Next i

End Sub

在VBA编码中更有效->高效的VBA循环

2 个答案: