时间戳

首页 > 解决方案 > VBA将公式插入表格非常慢

excel - VBA将公式插入表格非常慢

问题描述

我有一个打开的工作簿，将使用过的单元格变成一个表格，然后将不同的公式注入每一列。我正在注入公式以通过预先将公式向下拖动到比需要的更远的位置来节省文件大小。我必须这样做的 VBA 工作正常，但速度非常慢。我已经运行了性能检查，可以确认缓慢是由公式注入引起的（每秒只能注入 141 行）。我已经完成了基本的计算/屏幕更新相关的优化。还可以做些什么来加快以下代码的速度？（注意我已简化为代码的相关部分）：

Sub OptimizeVBA(isOn As Boolean)
  Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
  Application.EnableEvents = Not(isOn)
  Application.ScreenUpdating = Not(isOn)
  ' ActiveSheet.DisplayPageBreaks = Not(isOn)
End Sub

Private Sub Workbook_Open()
    OptimizeVBA True

    Dim ws As Worksheet
    Set ws = Worksheets("Book1")
    Dim tbl As ListObject
    Set tbl = ws.ListObjects("Table1")

    tbl.ListColumns("Dollar Share ").DataBodyRange.Formula = "=IFERROR(([@[Dollar Share  ]] - MEDIAN([[Dollar Share  ]])) / STDEV.P([[Dollar Share  ]]), """")"
    tbl.ListColumns("Unit Share ").DataBodyRange.Formula = "=IFERROR(([@[Unit Share  ]] - MEDIAN([[Unit Share  ]])) / STDEV.P([[Unit Share  ]]), """")"
    tbl.ListColumns("Units PSPW ").DataBodyRange.Formula = "=IFERROR(([@[Units PSPW  ]] - MEDIAN([[Units PSPW  ]])) / STDEV.P([[Units PSPW  ]]), """")"
    tbl.ListColumns("Dollar Growth ").DataBodyRange.Formula = "=IFERROR(IF(OR([@[Dollar Growth  ]] = """", [@[Dollars, Yago]] < New_Item_Floor), """", ([@[Dollar Growth  ]] - MEDIAN([[Dollar Growth  ]])) / STDEV.P([[Dollar Growth  ]])), """")"
    tbl.ListColumns("Unit Growth ").DataBodyRange.Formula = "=IFERROR(IF(OR([@[Unit Growth  ]] = """", [@[Dollars, Yago]] < New_Item_Floor), """", ([@[Unit Growth  ]] - MEDIAN([[Unit Growth  ]])) / STDEV.P([[Unit Growth  ]])), """")"
    tbl.ListColumns("Comp Avg % ACV ").DataBodyRange.Formula = "=IFERROR(([@[Comp Avg % ACV  ]] - MEDIAN([[Comp Avg % ACV  ]])) / STDEV.P([[Comp Avg % ACV  ]]), """")"

    OptimizeVBA False
End Sub

我知道与 Excel 对象的选择/其他交互很昂贵，但鉴于上述公式不同，我无法找到一种简单的方法来减少每列的单独交互。

笔记：

在此先感谢您的帮助！

标签： excelvba

解决方案

我将在这里为您提供我的测试，因为这是太多的注释代码。

我更改了您的代码以直接粘贴公式。我测试为字符串（由于缺少您的表格设置），它基本上是即时的。所以肯定有一些与桌子有关的恶作剧发生。请在你的桌子上试试。您只需要根据需要调整范围/工作表：

Private Sub Workbook_Open()
    OptimizeVBA True

    Dim ws As Worksheet
    Set ws = ActiveSheet


    ws.Range("A2:A200000").Formula = "=IFERROR(([@[Dollar Share  ]] - MEDIAN([[Dollar Share  ]])) / STDEV.P([[Dollar Share  ]]), """")"
    ws.Range("B2:B200000").Formula = "=IFERROR(([@[Unit Share  ]] - MEDIAN([[Unit Share  ]])) / STDEV.P([[Unit Share  ]]), """")"
    ws.Range("C2:C200000").Formula = "=IFERROR(([@[Units PSPW  ]] - MEDIAN([[Units PSPW  ]])) / STDEV.P([[Units PSPW  ]]), """")"
    ws.Range("D2:D200000").Formula = "=IFERROR(IF(OR([@[Dollar Growth  ]] = """", [@[Dollars, Yago]] < New_Item_Floor), """", ([@[Dollar Growth  ]] - MEDIAN([[Dollar Growth  ]])) / STDEV.P([[Dollar Growth  ]])), """")"
    ws.Range("E2:E200000").Formula = "=IFERROR(IF(OR([@[Unit Growth  ]] = """", [@[Dollars, Yago]] < New_Item_Floor), """", ([@[Unit Growth  ]] - MEDIAN([[Unit Growth  ]])) / STDEV.P([[Unit Growth  ]])), """")"
    ws.Range("F2:F200000").Formula = "=IFERROR(([@[Comp Avg % ACV  ]] - MEDIAN([[Comp Avg % ACV  ]])) / STDEV.P([[Comp Avg % ACV  ]]), """")"

    OptimizeVBA False
End Sub

您的评论问题：如何使用自动填充来完成此类任务：

Sub autof()
    Cells(1, 1).Value = 1
    Cells(1, 2).Value = 2
    Range(Cells(1, 1), Cells(1, 2)).AutoFill Range(Cells(1, 1), Cells(10, 2)), xlFillCopy
End Sub

推荐阅读