我正在尝试构建一个宏，根据输入到单元格A2中的值，生成日期和时间。目前每个单位需要1分5秒才能完成。班次将在00:30结束，并在05:30重新开始，所以我希望考虑到这一点。
一些例子
如果日期/时间是14/03/2017 22:00，我在单元格A2中输入55，我预计单元格E2将返回14/03/2017 23:00。 如果日期/时间是14/03/2017 22:00，我在单元格A2中输入1，我预计单元格E2将返回14/03/2017 22:01。 如果时间是14/03/2017 23:55，我进入55进入单元格A2，我希望回到15/03/2017 05:55
所以目前我正在使用这个在移位中运行良好的代码，但我无法继续使用它，即。进入下一天的生产。 范围（“A2”）。值*范围（“C2”）。值+现在（）
A2是单位数，C2是处理时间0,1,5
非常感谢您的帮助/建议
答案 0 :(得分：1)
我不确定问题是什么。数学是（单位*每单位时间）+开始时间。括号仅供视觉使用;数学优先级将确保乘法发生在加法之前。
With Worksheets("sheet1")
.Range("E2") = Now
.Range("F2") = .Range("E2").Value2 + (.Range("A2").Value2 * .Range("C2").Value2)
.Range("G2") = Application.Ceiling(.Range("F2").Value2, TimeSerial(0, 0, 1))
.Range("E2:G2").NumberFormat = "[Color10][$-en-US]dd-mmm-yyyy hh:mm;[Color3]@"
End With
FWIW，我使用.Value2代替.Value取得了更好的成功，因为它是一个没有额外日期/时间/货币信息的原始数字。
答案 1 :(得分：0)
这需要一点时间，但事实证明相当不错。按照这些说明进行测试。 在工作簿中创建要在其中执行操作的标准代码模块。默认情况下，名称将为“Module1”。我建议你将它改为“Main”或更好的描述性名称。将以下枚举粘贴到模块的顶部，包括选项语句。
Option Explicit
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
此枚举用于标识工作表中的行和列。请注意，列已编号（1 = A，2 = B，3 = C等）。没有值的枚举假定前一个+1的值。因此，NwsEnd = 4 = D列。您可以根据枚举设置工作表或调整枚举值以匹配工作表，但每个数量，生产时间，生产开始时间和生产完成都必须有一列时间。 NwsFirstDataRow用于防止宏更改您不想更改的数据 - 至少是标题行中的数据，此处假定为第1行。 现在超过上面的下一个枚举。
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)
' 20 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 = StartTime + 1 + Int(Qty / DayQty)
ComplDate = ComplDate + UnitTime * (Qty Mod DayQty)
End If
.Cells(NwsEnd).Value = ComplDate
End If
End With
End Sub
它的基本计算方法是首先计算从生产开始到当天班次结束可以生产多少单位。然后计算整天的生产量，并根据最后一天生产的剩余单位数计算完成量。如果缺少3个必需组件中的任何一个（数量，时间，开始时间），则不会进行此类计算。以下功能有助于计算。将它们粘贴在同一“主”代码模块的底部。
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
当处理时间计算所需的双类型数时，VB难以计算零。添加到结果中的0.000001可确保在需要零时计算不会低于零。下一个函数将编码的移位时间从Enum Nsh转换为该程序可以使用的几天。
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
下一个函数更正了StartTime列NwsStart中的错误条目。
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
此功能的作用是确保没有人像凌晨4点那样进入。如果有人这样做，那么参赛作品将改为05:30，因为这是轮班开始的时候。 此代码表中的最后一个过程将格式化单元格。
Sub FormatCells(Row As Range)
' 19 Mar 2017
Dim Fmt As Variant, Clm As Variant
Dim i As Integer
' match for number formats in 'Fmt' to the column numbers in 'Clm'
Clm = Array(NwsQty, NwsTime, NwsStart, NwsEnd)
Fmt = Array("#,##0", "hh:mm:ss", "dd mmm hh:mm", "dd mmm hh:mm")
For i = 0 To UBound(Clm)
Row.Cells(Clm(i)).NumberFormat = Fmt(i)
Next i
End Sub
只要输入生产数量，就会调用此子订单。您可以在此处调整单元格格式。这尤其适用于我可能根据自己的喜好做的日期格式。
现在，仍然在VBE窗口中，请找到工作表的代码表，其中列出了上面列的列。它可能在项目窗口中列为Sheet1(Sheet1)或类似名称。请务必确定正确的表格并在此处粘贴以下程序。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' 20 Mar 2017
Dim Entry As Variant
With Target
' no action when more than one cell is modified at once
If .Cells.Count = 1 And .Row >= NwsFirstDataRow Then
Application.EnableEvents = False
Entry = .Value
Select Case .Column
Case NwsQty
If Val(Entry) < 1 Then
If Len(Entry) > 0 Then
MsgBox "Please enter a number representing" & vbCr & _
"the quantity to be produced.", vbExclamation, _
"Invalid entry"
.Select
End If
Else
FormatCells Rows(.Row)
SetCompletion ActiveSheet, .Row
End If
Case NwsTime
If Val(Entry) Then
SetCompletion ActiveSheet, .Row
Else
If Len(Entry) > 0 Then
MsgBox "The production time must be entered" & vbCr & _
"in the format h:m:s", vbExclamation, _
"Invalid entry"
.Select
End If
End If
Case NwsStart
If Val(Entry) Then
If (Val(Entry) < 1) Then .Value = Entry + Date
Entry = AdjustedStartTime(.Value)
If .Value <> Entry Then
MsgBox "On " & Format(Entry, "mmm d") & " production doesn't " & _
"start until " & Format(Entry, "h:mm") & "." & vbCr & _
"Your entry was adjusted accordingly.", _
vbInformation, "Corrected time entry"
.Value = Entry
End If
SetCompletion ActiveSheet, .Row
Else
MsgBox "The production start must be entered as a Time" & vbCr & _
"or Dtae/Time value in the format [d/m/yy] HH:mm", _
vbExclamation, "Invalid entry"
.Select
End If
Case NwsEnd
MsgBox "Recalculate with a new production start?" & vbCr & _
"The completion date is the result of a calculation." & vbCr & _
"To change it, modify the unit production time.", _
vbInformation, "Invalid action"
Application.Undo
End Select
Application.EnableEvents = True
End If
End With
End Sub
通过阅读可以吐出的各种错误消息，您可以了解此过程的作用。您可以修改这些文本。请注意，您可以将开始时间输入为时间或日期/时间。如果输入时间，则宏将自动添加当前日期。如果没有错误，这个宏将调用子SetCompletion，如果存在计算的所有标准，它将把完成日期写入工作表。
请注意，更改Enum Nsh后无法保护您的数据。为避免覆盖使用先前正确的班次计算的现有完成日期，请设置枚举NwsFirstDataRow以排除您希望以这种方式保护的行。
所有组件都经过测试，但整个项目相当复杂，您可以在现实生活中观察结果。您可能已经注意到，我已经以这样的方式构造代码，即故障可以很容易地归因于特定的功能，这些功能可能必须在不对所有问题进行质疑的情况下进行改进。
答案 2 :(得分：0)
问题在于日期格式，更具体地说，是开始时间列中的输入日期格式。宏将仅计算是否给出了开始时间。因此，当给出开始时间但未被识别时，不会进行计算。
我为日/月/年编程，您正在使用美国系统。请用这个替换现有的同名程序。
Sub FormatCells(Row As Range)
' 25 Mar 2017
Dim Fmt As Variant, Clm As Variant
Dim i As Integer
' match for number formats in 'Fmt' to the column numbers in 'Clm'
Clm = Array(NwsQty, NwsTime, NwsStart, NwsEnd)
Fmt = Array("#,##0", "hh:mm:ss", "mmm dd hh:mm", "mmm dd hh:mm")
For i = 0 To UBound(Clm)
Row.Cells(Clm(i)).NumberFormat = Fmt(i)
Next i
End Sub
还对事件过程进行了修改，现在将识别以您的格式输入的日期。请记住，你应该能够在7:30输入开始时间，并在3月25日07:30进行单元格显示。试试这个。也尝试输入“3月20日7：30”，“3/20/17 7:30”，“3/20 7:30”，然后“3/20/17 14:00”，也许是“3/20 / 17下午2:00“。如果它不起作用，那将表明幕后更大的错误。
Private Sub Worksheet_Change(ByVal Target As Range)
' 25 Mar 2017
Dim Entry As Variant
With Target
' no action when more than one cell is modified at once
If .Cells.Count = 1 And .Row >= NwsFirstDataRow Then
Application.EnableEvents = False
Entry = .Value
Select Case .Column
Case NwsQty
If Val(Entry) < 1 Then
If Len(Entry) > 0 Then
MsgBox "Please enter a number representing" & vbCr & _
"the quantity to be produced.", vbExclamation, _
"Invalid entry"
.Select
End If
Else
FormatCells Rows(.Row)
SetCompletion ActiveSheet, .Row
End If
Case NwsTime
If Val(Entry) Then
SetCompletion ActiveSheet, .Row
Else
If Len(Entry) > 0 Then
MsgBox "The production time must be entered" & vbCr & _
"in the format h:m:s", vbExclamation, _
"Invalid entry"
.Select
End If
End If
Case NwsStart
If IsDate(Entry) Then
If (CDbl(Entry) < 1) Then .Value = Entry + Date
Entry = AdjustedStartTime(.Value)
If .Value <> Entry Then
MsgBox "On " & Format(Entry, "mmm d") & " production doesn't " & _
"start until " & Format(Entry, "h:mm") & "." & vbCr & _
"Your entry was adjusted accordingly.", _
vbInformation, "Corrected time entry"
.Value = Entry
End If
SetCompletion ActiveSheet, .Row
Else
MsgBox "The production start must be entered as a Time" & vbCr & _
"or Date/Time value in the format [m/d/yy] HH:mm", _
vbExclamation, "Invalid entry"
.Select
End If
Case NwsEnd
MsgBox "Recalculate with a new production start?" & vbCr & _
"The completion date is the result of a calculation." & vbCr & _
"To change it, modify the unit production time.", _
vbInformation, "Invalid action"
Application.Undo
End Select
Application.EnableEvents = True
End If
End With
End Sub
最后但并非最不重要的是，我发现计算完成时间时出现错误，影响生产时间，而不是在同一天结束。我纠正了。请交换功能。
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
实际上，这个程序应该进一步修改以识别周末，但我希望你的作品不会在周日停止： - ）
如果您仍然面临日期问题，我将非常感谢您。我可以更改我的PC上的默认设置以获得更好的测试，但到目前为止我已经避免这样做了。 ： - ）
答案 3 :(得分：0)
应根据您要对代码进行的更改来更改事件过程中的文本。请更换如下： -
MsgBox "You entered a time during which production rests." & vbCr & _
"The next shift after that will start on " & _
Format(Entry, "dddd,") & vbCr & _
Format(Entry, "mmmm d,") & " at " & _
Format(Entry, "h:mm") & "." & vbCr & _
"Your entry was adjusted accordingly.", _
vbInformation, "Corrected time entry"
' MsgBox "On " & Format(Entry, "mmm d") & " production doesn't " & _
' "start until " & Format(Entry, "h:mm") & "." & vbCr & _
' "Your entry was adjusted accordingly.", _
' vbInformation, "Corrected time entry"
意思是，在上面的开头查找带有撇号的代码行，并用没有撇号的留置替换它们。
我建议您在刚开始的新主题中发布此主题的链接。