Question

我正在创建一个自定义＆＃34;工作时间表＆＃34; excel中的计划程序，具有各种用户表单和控件。在此工作簿中，包含所有数据的主表如下所示：

Task1 | Worker 1 | Supervisor 1 | Due Date 1(W) | Due Date 2(S)
Task2 | Worker 2 | Supervisor 2 | Due Date 2(W) | Due Date 3(S)
Task3 | Worker 3 | Supervisor 1 | Due Date 1(W) | Due Date 2(S)
Task4 | Worker 2 | Supervisor 2 | Due Date 4(W) | Due Date 5(S)
Task5 | Worker 1 | Supervisor 1 | Due Date 3(W) | Due Date 4(S)

我需要的是在特定月份的单独表格上构建此数据的日历样式表示。我有超过20名工人，几个主管，任务是独特的（超过200），可能重复到期日（即每个工人每周不同的行数）。采用以下格式：

              Business_Week1 Business_Week2 Business_Week3 Business_Week4
Supervisor 1  Task           Task           Task           Task
SuperVisor 2  Task           Task           Task           Task
Worker 1      Task           Task           Task           Task
Worker 2      Task           Task           Task           Task
Worker 3      Task           Task           Task           Task

据我了解，我需要几个子/函数来执行这样复杂的过程： 1）创建所选月份的营业周日期（周一至周五）。 2）在列中找到唯一值的数组＆＃34; worker＆＃34; ＆＃34;主管＆＃34; 3）获取功能以检查截止日期是否在工作周之间 4）使用每个worker \ supervisor和date函数的循环将任务粘贴到每个personell的业务周的相关列中。

我设法做了，找到了一些这样的步骤，但努力合并为一个并做主要的procidure。

Function BetweenDates(startDate As String, endDate As String, testDate As String) As Boolean
    BetweenDates = IIf(CDate(testDate) >= CDate(startDate) And CDate(testDate) <= CDate(endDate), True, False)
End Function

Sub BusinessWeeks()
    Dim dStart As Date
    Dim dEnd As Date
    Dim rw As Integer
    Dim C_month As Date

    C_month = "01/10/2017"
FirstDayInMonth = DateSerial( _
 Year(C_month), Month(C_month), 1)

LastDayInMonth = DateSerial( _
 Year(C_month), Month(C_month) + 1, 0)

    rw = 2
    While FirstDayInMonth < LastDayInMonth
        If Weekday(FirstDayInMonth) = vbMonday Then
            Cells(2, rw).value = FirstDayInMonth
            Cells(2, rw).NumberFormat = "dd/mm/yyyy"
        End If
        If Weekday(FirstDayInMonth) = vbFriday Then
            Cells(3, rw).value = FirstDayInMonth
            Cells(3, rw).NumberFormat = "dd/mm/yyyy"
            rw = rw + 1
        End If
        FirstDayInMonth = FirstDayInMonth + 1
    Wend
End Sub

Sub FindUnique()

    Dim varIn As Variant
    Dim varUnique As Variant
    Dim iInCol As Long
    Dim iInRow As Long
    Dim iUnique As Long
    Dim nUnique As Long
    Dim isUnique As Boolean

    varIn = Selection
    ReDim varUnique(1 To UBound(varIn, 1) * UBound(varIn, 2))

    nUnique = 0
    For iInRow = LBound(varIn, 1) To UBound(varIn, 1)
        For iInCol = LBound(varIn, 2) To UBound(varIn, 2)

            isUnique = True
            For iUnique = 1 To nUnique
                If varIn(iInRow, iInCol) = varUnique(iUnique) Then
                    isUnique = False
                    Exit For
                End If
            Next iUnique

            If isUnique = True Then
                nUnique = nUnique + 1
                varUnique(nUnique) = varIn(iInRow, iInCol)
            End If

        Next iInCol
    Next iInRow
    ReDim Preserve varUnique(1 To nUnique)

End Sub

我如何结合这些并添加循环语句来实现目标？提前谢谢！

将数据范围重组为日历视图（按工作周汇总）

0 个答案: