Question

@Variatus参考你一直在努力的宏观，对于星期五的制作，班次仍将在05:30开始，但在18:30结束，如果星期六制作，班次将从07:00开始，到14点结束： 00。我是否正确地认为我需要在开始和结束时间添加另一个名为Day 5 Nsh的Enum，然后在第6天再次添加相同的第6天Nsh。如果这是正确的，那么在子Setcompletion中我将如何调用它。是否需要引用宏中的任何其他位置？

Enum Nws                ' Worksheet navigation
NwsFirstDataRow = 2
NwsQty = 1          ' Columns (not necessarily contiguous):
NwsTime             ' time to produce one unit
NwsStart            ' date/time
NwsEnd              ' date/time
End Enum
Enum Nsh                ' Shift  (use 24h format)
NshStart = 530      ' read as 05:30 (on current day)
NshEnd = 2430       ' read as 00:30 (on next day)
End Enum

下

Sub SetCompletion(ws As Worksheet, R As Long)
' 25 Mar 2017

Dim Qty As Long
Dim ShiftQty As Long, DayQty As Long
Dim UnitTime As Double, StartTime As Double
Dim ComplDate As Double
Dim Days As Integer

With Rows(R)
    Qty = .Cells(NwsQty).Value
    UnitTime = .Cells(NwsTime).Value
    StartTime = .Cells(NwsStart).Value
    If Qty And (UnitTime > 0) And (StartTime > 0) Then
        ComplDate = (UnitTime * Qty) + StartTime
        ShiftQty = QtyTillShiftEnd(StartTime, UnitTime)

        If ShiftQty < Qty Then
            Qty = Qty - ShiftQty
            DayQty = DailyProduction(UnitTime)
            ComplDate = Int(StartTime) + 1 + NshToDays(NshStart) + Int(Qty / DayQty)
            ComplDate = ComplDate + UnitTime * (Qty Mod DayQty)
        End If

        .Cells(NwsEnd).Value = ComplDate
    End If
End With
End Sub

下

Private Function QtyTillShiftEnd(ByVal StartTime As Double, _
                              ByVal UnitTime As Double) As Double
' 20 Mar 2017

Dim ProdTime As Double

ProdTime = (Int(StartTime) + NshToDays(NshEnd) - StartTime)
QtyTillShiftEnd = (ProdTime + 0.0001) / UnitTime
End Function

下

Private Function DailyProduction(UnitTime As Double) As Integer
' 19 Mar 2017
DailyProduction = Int((NshToDays(NshEnd) - NshToDays(NshStart) + 0.000001) / UnitTime)
End Function

下

Private Function NshToDays(TimeCode As Nsh) As Double
' 19 Mar 2017

Dim H As Double, M As Double

H = Int(TimeCode / 100)
M = TimeCode Mod 100
NshToDays = (1 / 24 * H) + (1 / 24 / 60 * M)
End Function

下

Function AdjustedStartTime(ByVal StartTime As Double) As Double
' 19 Mar 2017
' return new StartTime or 0

Dim Fun As Double
Dim StartDate As Long
Dim ShiftStart As Double, ShiftEnd As Double

ShiftStart = NshToDays(NshStart)
ShiftEnd = NshToDays(NshEnd)
StartDate = Int(StartTime)
StartTime = StartTime - StartDate
Fun = StartTime

If ShiftEnd > 1 Then
    If StartTime < (ShiftStart - Int(ShiftStart)) Then
        If StartTime > (ShiftEnd - Int(ShiftEnd)) Then Fun = ShiftStart
    End If
Else
    If (StartTime - Int(StartTime)) < ShiftStart Then
        Fun = ShiftStart
    Else
        If StartTime > ShiftEnd Then Fun = ShiftStart + 1
    End If
End If
AdjustedStartTime = Fun + StartDate
End Function

Answer 1

请在工作簿中设置命名范围，并将其命名为“SpecialDays”。我建议您创建一个专用工作表来存放它并使其可以在整个工作簿中访问。下图说明并解释。

程序的逻辑如下： -

标记为假日的任何一天都不会生产
任何一天标有“半班”的短暂班次
任何标记为“全班”的日子都会有完整的班次
除非日期标记为特殊日期
其他所有日子都会有一个完整的转变

此列表的重要部分在于顺序：首先应用的条件是优先条件。例如，在12月31日星期日将有一个完整的班次，因为“全班”的条件在当天是星期日之前得到满足，但如果它也被列为假日（在第二行，在任何地方由于假期首先被过滤掉，所以没有工作。

为了将范围与代码连接起来，请在代码表的枚举上方添加这三行。

' a named range of this name must exist:
' it must have 2 columns, first with a date, 2nd with a number as Nsh
Const SpecialDays As String = "SpecialDays"

您可以在此处更改范围的名称，但必须确保在此处以及您为该范围命名的工作表中使用相同的名称。

现在，正如您已经建议的那样，Enum Nsh需要扩展。这里是。只需将现有的全部替换为new（意味着将声明形成为“End Enum”。

Enum Nsh                ' Shift
    ' 28 Mar 2017
    NshFullShift = 0
    NshHalfShift
    NshNoShift
    NshStart = 530      ' read as 05:30 (on current day)
    NshEnd = 2430       ' read as 00:30 (on next day)
    NshHalfStart = 700  ' (use 24h format)
    NshHalfEnd = 1400
End Enum

前三个枚举对应于您可以在“SpecialDays”范围的第二列中输入的数字。

当然，必须修改SetCompletion过程。它现在单独计算每一天的产量，而不是假设每天的产量是相同的。

Sub SetCompletion(Ws As Worksheet, R As Long)
    ' 28 Mar 2017

    Dim Qty As Long, ShiftQty As Long
    Dim CommenceTime As Double, UnitTime As Double
    Dim ComplTime As Double

    With Rows(R)
        Qty = .Cells(NwsQty).Value
        UnitTime = .Cells(NwsTime).Value
        CommenceTime = .Cells(NwsStart).Value
        If Qty And (UnitTime > 0) And (CommenceTime > 0) Then
            ComplTime = CommenceTime + (UnitTime * Qty)
            Qty = Qty - QtyTillShiftEnd(CommenceTime, UnitTime)

            If Qty > 0 Then
                Do While Qty > 0
                    ComplTime = Int(ComplTime) + 1
                    ShiftQty = DailyProduction(ComplTime, UnitTime)
                    If Qty > ShiftQty Then
                        Qty = Qty - ShiftQty
                    Else
                        ComplTime = ComplTime + StartTime(ShiftType(ComplTime)) + (Qty * UnitTime)
                        Exit Do
                    End If
                Loop
            End If

            .Cells(NwsEnd).Value = ComplTime
        End If
    End With
End Sub

日常生产在不同的日子有所不同。因此，新功能将日期作为参数接收，并根据日期类型计算产量：假日，半班或全班日。当然，在CommenceTime开始的生产的第一天计算也是如此，而不是转变的开始。

Private Function QtyTillShiftEnd(ByVal CommenceTime As Double, _
                                 ByVal UnitTime As Double) As Double
    ' 28 Mar 2017

    Dim ProdTime As Double
    Dim ShType As Nsh

    ShType = ShiftType(CommenceTime)
    ProdTime = Int(CommenceTime) + EndTime(ShType) - CommenceTime
    QtyTillShiftEnd = Int((ProdTime + 0.0001) / UnitTime)
End Function

Private Function DailyProduction(ShiftDay As Double, _
                                 UnitTime As Double) As Integer
    ' 28 Mar 2017

    Dim ShType As Nsh

    ShType = ShiftType(ShiftDay)
    DailyProduction = Int((EndTime(ShType) - StartTime(ShType) + 0.0001) / UnitTime)
End Function

NshToDays函数原则上保持不变，但我修改了接收参数的方法（ByVal而不是之前的默认ByRef）。

Private Function NshToDays(ByVal TimeCode As Nsh) As Double
    ' 28 Mar 2017

    Dim H As Double, M As Double

    H = Int(TimeCode / 100)
    M = TimeCode Mod 100
    NshToDays = (1 / 24 * H) + (1 / 24 / 60 * M)
End Function

下一个功能已经过全面检修。现在它将找到下一个班次的开始，即使输入的开始时间是它应该的几天。

Function AdjustedStartTime(ByVal CommenceTime As Double) As Double
    ' 28 Mar 2017
    ' return new CommenceTime or 0

    Dim StartDate As Long
    Dim ShType As Nsh

    StartDate = Int(CommenceTime)
    ' if StartDate isn't a workday, then loop for a workday
    Do
        ShType = ShiftType(StartDate)
        If ShType <> NshNoShift Then Exit Do
        StartDate = StartDate + 1
    Loop

    If StartDate < CommenceTime Then
        ' StartDate is a workday:
        If CommenceTime > (StartDate + EndTime(ShType)) Then
            StartDate = StartDate + 1
        End If
    End If

    If StartDate < CommenceTime Then
        CommenceTime = CommenceTime - StartDate
        CommenceTime = Application.Max(CommenceTime, StartTime(ShType))
    Else
        CommenceTime = StartTime(ShType)
    End If

    AdjustedStartTime = CommenceTime + StartDate
End Function

FormatCells程序是3月25日以来的唯一幸存者。我相信你已经完全掌控它，并且知道如果它不能自己修改它就可以做你想做的事。

您可以在代码表的底部粘贴另外三个新程序（而不是具有偶数程序的程序）。 ShiftType是指特殊日期的函数，并确定每日班次的开始和结束时间（如果有的话）。

Private Function ShiftType(ByVal ShiftDate As Double) As Nsh
    ' 28 Mar 2017

    Dim Fun As Nsh
    Dim Rng As Range, Fnd As Range
    Dim Fmt As String

    ShiftDate = Int(ShiftDate)
    Set Rng = ThisWorkbook.Names(SpecialDays).RefersToRange.Columns(1)

    With Rng
        Fmt = .Cells(1).NumberFormat
        .NumberFormat = "General"
        Set Fnd = .Find(What:=ShiftDate, LookIn:=xlFormulas)
        .NumberFormat = Fmt
    End With

    If Fnd Is Nothing Then
        Fun = Application.Weekday(ShiftDate)
        If (Fun = vbSaturday) Or (Fun = vbSunday) Then
            Fun = NshNoShift
        Else
            Fun = NshFullShift
        End If
    Else
        Fun = CLng(Val(Fnd.Offset(0, 1).Value))
        Fun = Application.Min(Fun, NshNoShift)
        Fun = Application.Max(Fun, NshFullShift)
    End If
    ShiftType = Fun
End Function

最后两个函数根据ShiftType返回StartTime和EndTime。请注意，它们会在休息日返回0（零）。

Private Function StartTime(ShType As Nsh) As Double
    ' 28 Mar 2017
    On Error Resume Next
    StartTime = NshToDays(Array(NshStart, NshHalfStart, 0)(ShType))
    Err.Clear
End Function

Private Function EndTime(ShType As Nsh) As Double
    ' 28 Mar 2017
    On Error Resume Next
    EndTime = NshToDays(Array(NshEnd, NshHalfEnd, 0)(ShType))
    Err.Clear
End Function

基本上，你的代码像以前一样工作，但它已经变得更加复杂，这意味着它有更多的点可以在没有足够注意的情况下发生。我希望您能够找到对您可能发现的任何故障负责的程序，并且可以自行修复。毕竟，每个程序本身都相当简单。祝你好运！

为不同的开始和结束时间调用sub

1 个答案: