减少返回计数的for循环执行时间 [英] Reduce for loop execution time that returns a count
问题描述
我要实现的目标
我有两张纸:仪表板"和临时计算".
仪表板具有所有员工详细信息，范围"N1"和"N2"包含日期.
现在，一个宏将填充员工数据并生成一个日程日历，如下图所示"temp calc"具有其项目详细信息，其开始日期为结束日期(此处不删除仪表板中介于n1和n2之间的日期.)
I have two sheets: 'dashboard' and 'temp calc'.
Dashboard has all employee details and range "N1" "N2" contain dates.
Now a macro populates employee data and generates a daywise calendar as shown in the following image
'temp calc' has their project details with start date end date.(the date that do not fall between n1 and n2 dates from dashboard sheet are deleted here).
因此，现在从仪表板工作表中引用他们的空，并使用仪表板工作表中填充的第一天，我遍历temp Calc工作表中的emp id，并返回员工在特定日期当前正在从事的项目数的计数.如下图所示.
So now referencing their empid from dashboard sheet, and using the first day populated in dashboard sheet i loop through the emp id in temp calc sheet and return a count for the number of projects a employee is currently working on for the particular day. as shown in the following image.
我如何实现这一目标:
代码.....
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
我的问题:代码可以完成任务，但是我有两个问题.
My problem: The code does the job,but I have two problems.
-
太慢了
It is too slow
有时工作簿会说没有响应，也不会做任何工作.我已经检查过它在后台不起作用.我让程序运行了一整夜，结果没有响应.
Sometimes the workbook will say not responding and won't do the work.I've checked it does not work in the background. I left the program running overnight and it went into not responding.
可能的解决方案:
-
使用两个数组:一个数组用于将Empid存储在仪表板中，第二个数组用于存储在仪表板中生成的日历.然后将其与temp calc表中的数据进行比较，然后将计数返回到数组2中并写回问题是我刚开始阅读有关数组的内容，但我仍在学习
using two arrays: one array to store empid in dashboard,second array to store calendar generated in dashboard. and then compare it with data from temp calc sheet and return a count into array number 2 and write it back the problem is I've just started reading about arrays and I am still learning
我愿意接受其他可能的选择:
I am open to possible alternatives:
欢呼声，
马修
推荐答案
这对我有用.....希望对其他有相同问题的人有所帮助.非常感谢所有为我提供帮助的人，也感谢每个人的建议和答案....:)
This works for me..... Hope it will be helpful for someone else with the same problem.. A big thank you to everyone who helped me with this and also for everybodys suggestions and answers.... :)
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
这篇关于减少返回计数的for循环执行时间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
