macros运行非常缓慢：如何加快这个macros？
朋友们，
我有一个工作表，我正在使用“Auto Present”macros。 但是这个macros运行速度非常慢，慢慢地说，即使其他macros只花了几分之一秒，它也要花费5秒以上的时间。 我不知道这是为什么。
所以，朋友我的实际要求和我生成的代码是张贴在下面。 请帮我解决这个问题。
矿山的实际需求。
我有一个用于input员工详细信息的电子表格。 我正在进入员工的日常出勤状态。 我在每个员工状态细胞上使用数据validation。 意思是，我从“数据validation列表”菜单中select员工的状态。 现在差不多有600名员工，进入每个员工的状态是一项艰巨的任务。 所以我需要的是，我可以进入缺席，休假等等，剩下的没有标志的工作人员将会出席。 所以我需要一个命令button。 所以，当我点击那个button，它应该自动应用“P”在该特定date的列上的其余单元格。 更清楚的是，我有一个月每天31列，每列7日包含特定date的date。 所以macros必须在当前date的特定列之间search空的CELL，并在单击命令button时用“P”填充它。 空单元格将在每一列的第8行至第500行之间。 还有一件事macros观必须检查。 每天的空单元格必须填写，如果单元格中的“B”单元格具有任何值（input员工名称）。 更清楚的是，我正在从第8行到第500行的“B”列input员工姓名。 所以，单击命令button后，macros必须find包含列的特定date，并find该列的第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 我将你的代码转储到一个新的工作簿Sheet1的模块中，声明了Option Explicit并试图编译它。
首先Colcnt没有被宣布，所以我猜测Dim Colcnt as Long就足够了。 这解决了编译错误。
接下来我在F7:AJ17设置了从1/1/14到31/1/14的date，添加了一个CommandButton并Sub Button506_Click()分配了Sub Button506_Click() 。
在B8:B508我设置了一个数据有效性下拉列表Absent, Casual, Leave和随机单元格以填充下拉列表中的项目。 击中button，它瞬间跑了！
这是没有Application.ScreenUpdating = False或Application.EnableEvents = False所以代码本身是好的。
尝试Application.Calculation = xlManual在您的代码和Application.Calculation = xlAutomatic只是在End Sub
其他问题可能是：
- 依赖的单元格/计算器每次在
F8:AJ508更改单元格时触发F8:AJ508在“公式”选项卡上检查是否有任何依赖项可以在范围内的单元格更改时重新计算。 - 任何其他打开的工作簿 – closures它们并尝试运行您的代码。
你已经说过，调用Application.EnableEvents = False没有效果，所以我假设你在工作簿或Personal.xls*没有基于事件的过程Personal.xls*
也许这有助于使用一些Excel的内置function，如发现…我还没有尝试过：
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
使用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
之前 
后 