1

以下のマクロは、従業員のプロジェクトの日付を複数の列に入力された日と比較し、従業員が特定の日に取り組んでいる現在の割り当ての数をカウントするために使用されます。

例:- 範囲 Q3:Au3 が 2013 年 10 月の日付で満たされている場合、q3:10 月 1 日、r3:10 月 2 日、s3:10 月 3 日など。私のコードは、これらの個々の日付をシート一時計算の従業員の開始日と終了日と比較し、従業員 ID をカウントして、従業員が取り組んでいる割り当ての数を返します。コードは正常に動作しますが、実行には時間がかかります (約 50,000 人の従業員がいるため) 最初にシートにデータを取得した後、フィルターを適用して、撤回、非アクティブ、および他の従業員などの冗長データを削除します。フィルターを使用して、比較範囲に含まれない従業員を削除しますが、従業員は依然として巨大であり、実行時間も長くなります。

十分な詳細を提供できなかった場合は、下のリンクにファイルを添付しましたので、ご覧ください。

https://docs.google.com/file/d/0B2CrBtuXvhrJSkgwbFZEWHYycTg/edit?usp=sharing

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
4

1 に答える 1

0

これは私にとってはうまくいきます.....そして、それは非常に高速です....みんなの助けに感謝します:)

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
于 2013-07-11T06:25:21.237 に答える