减less返回计数的循环执行时间

我正在努力实现的

我有两个表：“仪表板”和“临时计算”。
仪表板包含所有员工详细信息，范围“N1”“N2”包含date。
现在，一个macros填充员工数据并生成一个日历日历，如下图所示 “temp calc”的项目详细信息包括开始date结束date（不包括来自仪表板表单的n1和n2date之间的date在此删除）。

因此，现在从仪表板表中引用他们的empid，并使用在仪表板表中填写的第一天，通过临时计算表中的emp id循环，并返回当前员工当前正在为特定date处理的项目数。 如下图所示。

我如何实现这一点：

代码…..

Option Explicit Sub Count() ' x= no of columns(dashboard calender) ' y= no of rows(dashboard emp id) ' z= no of rows(temp calc sheet emp id) Application.ScreenUpdating = False 'Clear calender data Range("Q4").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.ClearContents Dim i, j, k, l, d, x, y, z, Empid As Long Dim currentdate, startdate, enddate As Date x = (Range("n2") - Range("n1")) + 1 y = Application.WorksheetFunction.counta(Range("A:A")) - 1 z = Application.WorksheetFunction.counta(Worksheets("Temp Calc").Range("A:A")) - 1 For i = 1 To y Step 1 'To loop through the emp_id in dashboard. For j = 1 To x Step 1 'To loop through the calender in dashboard daywise. d = 0 For k = 1 To z Step 1 'To loop through the emp_id i temp calc sheet. Empid = ActiveSheet.Cells(i + 3, 1).Value currentdate = Cells(3, 16 + j).Value startdate = Worksheets("Temp calc").Cells(k + 1, 3).Value enddate = Worksheets("Temp calc").Cells(k + 1, 4).Value If (Worksheets("Temp calc").Cells(k + 1, 1).Value) = Empid Then If (currentdate >= startdate) And (currentdate <= enddate) Then 'To check whether the first column date falls within the project start and end date d = d + 1 End If End If Next Worksheets("Dashboard").Cells(i + 3, j + 16) = d Next Next Range("q4").Select Application.ScreenUpdating = True End Sub 

我的问题：代码做的工作，但我有两个问题。

1. 这太慢了

2. 有时工作簿会说没有反应，不会做这个工作。我检查过它不能在后台工作。 我一夜之间就离开了这个程序，并没有回应。

可能的scheme

1. 使用两个数组：一个数组用于在仪表板中存储empid，第二个数组用于存储在仪表板中生成的日历。 然后将其与来自临时计算表的数据进行比较，并将计数返回到数组2，并将其写回问题是我刚刚开始阅读有关数组，我仍在学习

2. 我愿意接受可能的select：

干杯，
马修

Answer 1

有几个内置函数可以很有效地完成这个任务。 我只在这里列出几个：

1. 使用自动filter仅select一组特定的数据（例如员工的自动filter或date范围的自动filter等） – 然后您可以只查看属于该员工的元素
2. 对员工进行sorting – 那么您只能通过有效的员工ID，当您到达下一个员工时，您将开始下一个循环
3. 使用数据透视表为您完成整个事情：创build一个左侧有员工ID，顶部date，并使用“计数”作为评估函数的表。 您可以使用数据透视表中的“filter”选项将其降至所需的date范围，或者可以在计算数据透视表之前将雇员表中的数据自动过滤到所需的范围

其中的任何一个都可以让你的代码更快速 – 我的个人偏好是选项3 …如果你不喜欢选项3的布局，并且你不能使它成为“如此”，那么创build数据透视表一个隐藏的工作表，并从那里复制数据到你想要的工作表。

另外，像COUNTA("A:A" ）这样的事情可能会很慢，因为这意味着要查看列中的所有150万个单元格，如果这些行是连续的，则应该可以执行如下操作：

 COUNTA(RANGE("A1", [A1].End(xlDown))) 

或（如果不是连续的）

 numRows = ActiveSheet.Cells.SpecialCells(xlLastCell).Row COUNTA(RANGE("A1", [A1].OFFSET(numRows,0))) 

Answer 2

这对我的作品…..希望这将有助于其他人有同样的问题..非常感谢大家谁帮助我，也为everybodys的build议和答案…. 🙂

  Sub assginment_count() Dim a, i As Long, ii As Long, dic As Object, w, e, s Dim StartDate As Date, EndDate As Date Set dic = CreateObject("Scripting.Dictionary") ' use dic as a "mother dictionary" object to store unique "Employee" info. dic.CompareMode = 1 ' set compare mode to case-insensitive. a = Sheets("temp calc").Cells(1).CurrentRegion.Value ' store whole data in "Temp Calc" to variable "a" to speed up the process. For i = 2 To UBound(a, 1) ' commence loop from row 2. If Not dic.exists(a(i, 1)) Then Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary") ' set child dictionary to each unique "Emp Id" End If If Not dic(a(i, 1)).exists(a(i, 3)) Then Set dic(a(i, 1))(a(i, 3)) = _ CreateObject("Scripting.Dictionary") ' set child child dictionary to each unique "Startdt" to unique "Emp Id" End If dic(a(i, 1))(a(i, 3))(a(i, 4)) = dic(a(i, 1))(a(i, 3))(a(i, 4)) + 1 ' add 1(count) to a unique set of "Emp Id", "Startdt" and "Finishdt", so that it enables to count as ' different match even if multiple same unique set of "Emp Id", "Startdt" and "Finishdt" appears. Next With Sheets("dashboard") StartDate = .[N1].Value: EndDate = .[N2].Value With .Range("a3").CurrentRegion.Resize(, .Rows(3).Find("*", , , , xlByRows, xlPrevious).Column) ' finding the data range, cos you have blank column within the data range. .Columns("q").Resize(.Rows.count - 3, .Columns.count - 16).Offset(3).Value = 0 ' initialize the values in result range set to "0". a = .Value ' store whole data range to an array "a" For i = 4 To UBound(a, 1) ' commence loop from row 4. If dic.exists(a(i, 1)) Then ' when mother dictionary finds "Employee" For Each e In dic(a(i, 1)) ' loop each "Startdt" For Each s In dic(a(i, 1))(e) ' loop corresponding "Finishdt" If (e <= EndDate) * (s >= StartDate) Then ' when "Startdt" <= EndDate and "Finishdt" >= StartDate For ii = 17 To UBound(a, 2) ' commence loop from col.Q If (a(3, ii) >= e) * (s >= a(3, ii)) Then ' when date in the list matches to date between "Startdt" and "Finishdt" a(i, ii) = a(i, ii) + dic(a(i, 1))(e)(s) ' add its count to corresponding place in array "a" End If Next End If Next Next End If Next .Value = a ' dump whole data to a range. End With End With End Sub