Excel 提高VBA编码效率-->；高效VBA循环

你能帮我更有效地写下面的代码吗？我正在制作一个主列表，在主列表中，我每个月都将来自不同来源的数据复制到Z、AC、AF、AI等列中（始终由2列分隔）。然后我一直复制该单元格，以更新每行的值。正如您在下面的代码中所看到的，代码的一部分与下一部分之间的唯一区别是：

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

我怎样才能使它更有效率？任何想法都将不胜感激

保重

' 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

---

根据我的经验，加速大多数宏的最有效方法是关闭屏幕更新。此外，如果您的工作表包含大量公式，则关闭自动计算会有很大帮助。我创建了一个方法来实现这一点，称为“快速模式”我在创建的每个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

---

尝试类似的方法。未经测试，但应该可以开始

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

Sub TT（）
Dim fromPath、vbaPath、vbaFile、订单列表2017
将shtpath作为工作表，shtOrders作为工作表
我和你一样长，rngFormula
是否将shtpath=Sheets（“P25 2017的文件路径”）设置为该工作簿？
Set shtOrders=ThisWorkbook.Sheets（“订单列表P25 2017”）
设置rngFormula=shtOrders.Range（“Z10”）’如果代码有效，那么它被认为是堆栈溢出的主题之外的，并且更适合@controlnetic.nomad。代码实际上不起作用，因为它需要很长时间才能加载，并且会导致我的计算机经常崩溃。因此我希望编写不同的代码。希望它清楚。感谢澄清，通过“崩溃”你的意思是“Excel运行（无响应）”？因为这不是崩溃，如果是这样，@controlnetic.nomad是正确的。
与
的工作方式与你似乎认为的不一样。在
与此工作簿.Sheets（“订单列表P25 2017”）
的正文中，
范围（）
自动引用该工作表。另一方面，
.Range（）
（注意点）将。首先使用变量，不要反复键入
工作表（“2017年第25页的文件路径”）
。并用工作簿限定该工作表-引用范围时也要具体，否则它会回来咬你。。。