减少返回计数

Question

我想实现

我有两片循环执行时间：“仪表盘”和“临时计算”。
仪表板包含所有员工详细信息和范围“N1”“N2”包含日期。
现在一个宏填充员工数据并生成如下图所示的日历日历 'temp calc'的项目详细信息包含开始日期结束日期（日期不在n1和n2日期之间）表格在这里被删除）。

因此，现在通过仪表板表引用他们的empid，并使用第一天填充在仪表板表中，我通过temp计算表中的emp id循环并返回一个员工当前正在为特定天。如下图所示。

我如何做到这一点：

代码.....

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. 有时，工作簿会说没有响应，并不会做work.I've检查它不会在后台工作。我让程序在一夜之间运行，并且没有响应。

可能的解决方案：

1. 使用两个阵列：一个阵列到EMPID存储在仪表盘，仪表板中产生的第二阵列来存储日历。然后将它与温度计算表中的数据进行比较，并将计数返回到数组编号2并将其写回 问题是我刚开始阅读有关数组，我仍在学习

2. 我对可能的替代方法开放：

欢呼声，
马修

Answer 1

这对我的作品.....希望这将是有用的人否则同样的问题.. 非常感谢大家谁与此也为每个人的建议和答案帮我.... :)

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 

Answer 2

有几个内置的功能，这将非常有效地做到这一点。这里只列出一对夫妇：

1. 使用自动过滤器仅选择一组特定的数据（例如，员工上的自动过滤器或日期范围上的自动过滤器等） - 然后您可以逐步浏览属于该员工的元素
2. 排序在员工身上 - 然后您只能浏览有效的员工ID，并且当您到达下一个员工时开始下一个循环
3. 使用数据透视表为您完成整个任务：创建表 ，其中员工ID在左侧，日期在顶部，并使用“count”作为正在评估的函数。您可以使用数据透视表中的过滤器选项将此数据下载到您想要的日期范围 - 或者您可以在计算数据透视表之前将雇员表中的数据自动过滤到您想要的范围内

任何这些应该让你的代码快很多 - 我的个人偏好是选项3 ...如果你不喜欢选项3的布局，并且你不能使它“如此”，那么在隐藏表中创建数据透视表并从那里复制数据到你想要的工作表。

顺便说一句 - 像COUNTA("A:A"这样的事情可能会很慢，因为这意味着要查看列中所有150万个单元格。如果行是连续的，你应该能够做这样的事情：

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

或者（如果不是连续的）

​​