宏运行很慢：如何加速这个宏？

Question

朋友们，

我有一个工作表，我在上面使用“自动呈现”宏。但是该宏的工作速度非常缓慢，缓慢意味着即使其他宏只需要不到一秒的时间，它也需要超过 5 秒的时间来处理。我不知道为什么会这样。

所以，朋友们我的实际需求和我生成的代码发布在下面。请帮我解决这个问题。

我的实际需求。

我有一个用于输入员工详细信息的电子表格。我正在输入员工的日常考勤状态。我正在对每个员工状态单元格使用数据验证。意味着，我正在从数据验证列表菜单中选择员工的状态。它有近 600 名员工，输入每个员工的状态是一项艰巨的任务。所以我需要的是，我可以在缺勤、临时休假等情况下进入……而其余未标记的员工将在场。所以我需要一个命令按钮来实现这个目的。因此，当我单击该按钮时，它应该自动在该特定日期列的剩余单元格上应用“P”。更清楚地说，我在一个月中的每一天都有 31 列，每列的第 7 行包含该特定日期的日期。所以宏必须在当前日期的特定列之间搜索空单元格，并在我单击命令按钮时用“P”填充它。空单元格将位于每天列的第 8 行到第 500 行之间。宏必须检查的另一件事。每天的空单元格只有在单元格各自的“B”单元格具有任何值（输入员工姓名的地方）时才需要填写。更清楚的是，我在“B”列的第 8 行到第 500 行中输入员工姓名。因此，在单击命令按钮后，宏必须找到包含特定日期的列，并找到该列的第 8 行到第 500 行之间的空单元格，并用“P”填充这些空单元格，前提是 B 列中有任何名称.

我的自动呈现 VBA 代码：

Private Sub Button506_Click()

    Dim BeginCol As Long
    Dim endCol As Long
    Dim ChkRow As Long
    Dim rng As Range
    Dim c As Variant

    Application.ScreenUpdating = False
    BeginCol = 6
    endCol = 37
    ChkRow = 7
    For Colcnt = BeginCol To endCol
           If Sheets("Sheet1").Cells(ChkRow, Colcnt).Value = Date Then
            Set rng = Sheets("Sheet1").Cells(ChkRow, Colcnt).Rows("2:500")
            For Each c In rng
                If Sheets("Sheet1").Cells(c.Row, 2).Value = "" Then
                    c.Value = "P"
                End If
            Next c
        Else
            'Sheets("Sheet1").Cells(ChkRow, Colcnt).EntireColumn.Hidden = True
        End If
    Next Colcnt

    Application.ScreenUpdating = True

End Sub

Answer 1

我将您的代码转储到一个新工作簿的 Sheet1 模块中，并声明了 Option Explicit，并尝试编译它。

首先Colcnt 尚未声明，所以我猜测Dim Colcnt as Long 就足够了。这样就解决了编译错误。

接下来，我在F7:AJ17 中设置从 1/1/14 到 31/1/14 的日期，添加一个 CommandButton 并为其分配 Sub Button506_Click()。

在B8:B508 列中，我设置了一个数据验证下拉列表Absent, Casual, Leave，并选择了随机单元格来填充下拉列表中的项目。按下按钮，它立即运行！

这没有Application.ScreenUpdating = False 或Application.EnableEvents = False 所以代码本身很好。

在代码顶部尝试Application.Calculation = xlManual，在End Sub之前尝试Application.Calculation = xlAutomatic

其他问题可能是：

• 每次您的宏更改 F8:AJ508 中的单元格时都会触发相关单元格/计算，因此请在“公式”选项卡上检查是否有任何从属单元格可以在范围内的单元格更改时重新计算。
• 任何其他打开的工作簿 - 关闭它们并尝试运行您的代码。

您已经说过调用 Application.EnableEvents = False 没有效果，所以我假设您在工作簿或 Personal.xls* 中没有基于事件的过程

Answer 2

也许使用一些excel的内置函数会有所帮助，比如find...我没试过：

Dim BeginCol As Long
Dim endCol As Long
Dim ChkRow As Long
Dim firstAddress
Dim rng As Range
Dim Colcnt As Integer
Dim c As Variant

Application.ScreenUpdating = False
BeginCol = 6
endCol = 37
ChkRow = 7

'loop columns
For Colcnt = BeginCol To endCol
    'check date
    If CDate(Sheets("Sheet1").Cells(ChkRow, Colcnt).Value) = Date Then
        Set rng = Sheets("Sheet1").Cells(ChkRow, Colcnt).Rows("2:500")
        'start search
        Set c = rng.Find("", LookIn:=xlValues, LookAt:=xlWhole)

        If Not c Is Nothing Then
            'save first address to break loop later
            firstAddress = c.Address
            'loop through empty cells
            Do
                'if cell B of same row contains value, write "P"
                If Sheets("Sheet1").Cells(c.row, 2).Value <> "" Then
                    c.Value = "P"
                End If
                'next cell
                Set c = rng.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End If
    DoEvents
Next Colcnt

Application.ScreenUpdating = True

Answer 3

使用Evaluate的快捷方式

这一行
x2 = Application.Evaluate("=IF((F8:AK500=""||"")*(F7:AK7=today())*(B8:B500<>""""),""p"",F8:AK500)")
本身就足够了........但它将空白单元格转换为0。所以需要多几行来支持它:)

Sub Quick()
y = Application.Evaluate("=IF(F8:AK500="""",""||"",F8:AK500)")
[f8:Ak500] = y
x2 = Application.Evaluate("=IF((F8:AK500=""||"")*(F7:AK7=today())*(B8:B500<>""""),""p"",F8:AK500)")
[f8:Ak500] = x2
Range("f8:Ak500").Replace "||", vbNullString
End Sub

之前

之后