Question

朋友，

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

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

我的实际需求。

我有一个电子表格，用于输入员工的详细信息。在那我就进入了员工的日常出勤状态。我在每个员工状态单元上使用数据验证。意思是，我从数据验证列表菜单中选择员工的状态。这是近600名员工，进入每个员工的状态是一项艰巨的任务。所以我需要的是，我可以参加缺席，休假等等......剩下的没有标记的工作人员将是现在。所以我需要一个命令按钮来实现这个目的。因此，当我点击该按钮时，它应该自动在该特定日期列的剩余单元格上应用“P”。更清楚的是，我在一个月内每天有31列，每列第7行包含该特定日期的日期。所以宏必须在当前日期的特定列之间搜索空CELL，并在我单击命令按钮时用“P”填充它。空单元格将在每天的列的第8行到第500行之间。还有一件事需要检查宏。每天的空单元格必须填充，如果单元格各自具有任何值的“B”单元格（输入员工姓名的位置）。更清楚的是，我在第8行到第500行的“B”列中输入了员工姓名。因此，在单击命令按钮后，宏必须找到包含列的特定日期，并在该列的第8行到第500行之间找到空单元格，并用“P”填充那些空CELLS，只要在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中设置了2014年1月1日到31/1/14的日期，添加了一个CommandButton并为其分配了Sub Button506_Click()。

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

没有Application.ScreenUpdating = False或Application.EnableEvents = False，因此代码本身就很好。

在代码顶部尝试Application.Calculation = xlManual，Application.Calculation = xlAutomatic

之前End Sub

其他问题可能是：

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

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

Answer 2

使用某些像Excel这样的excel内置函数可能会有所帮助......我还没有尝试过：

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

之前的 enter image description here

后的 enter image description here

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

3 个答案: