工时分配工时

cherry1314 · 发表于 2024-10-16 16:17

本帖最后由 cherry1314 于 2024-10-16 16:25 编辑

各位老师：请问如何将一个总工时，随机分配到一个月除周日的每一天，且每一天分配的工时不能超过8小时，请问这个能用公式实现吗？

hxj119 · 发表于 2024-10-16 17:25

建议用VBA处理！

Excel_muke · 发表于 2024-10-16 17:49

VBA实现

Sub DistributeHours()
Dim ws As Worksheet
Dim totalHours As Long
Dim workDays As Long
Dim dayIndex As Long
Dim currentDay As Long
Dim remainingHours As Long
Dim dailyHours As Long
' 设置工作表
Set ws = ThisWorkbook.Sheets("Sheet1")
' 清空之前的记录
ws.Range("B3:B40").ClearContents
' 获取总工时和工作日数量
totalHours = ws.Range("D2").Value
workDays = ws.Range("F2").Value
' 检查总工时是否超出每天8小时的限制
If totalHours > workDays * 8 Then
MsgBox "总工时过长，请重新分配！"
Exit Sub
End If
' 初始化每天的工作时间为0
For currentDay = 1 To workDays
ws.Cells(currentDay + 2, 2).Value = 0 ' B4开始记录
Next currentDay
' 分配工时
remainingHours = totalHours
Do While remainingHours > 0
For currentDay = 1 To workDays
If remainingHours = 0 Then Exit For
' 随机生成每天的工作时间，不超过8小时
dailyHours = Application.WorksheetFunction.Min(Int((remainingHours / (workDays - currentDay + 1)) * Rnd + 1), 8)
If ws.Cells(currentDay + 2, 2).Value + dailyHours <= 8 Then
ws.Cells(currentDay + 2, 2).Value = ws.Cells(currentDay + 2, 2).Value + dailyHours
remainingHours = remainingHours - dailyHours
Else
' 如果超出了最大值，选择一个较小的值
dailyHours = Application.WorksheetFunction.Min(remainingHours, 8 - ws.Cells(currentDay + 2, 2).Value)
If dailyHours > 0 Then
ws.Cells(currentDay + 2, 2).Value = ws.Cells(currentDay + 2, 2).Value + dailyHours
remainingHours = remainingHours - dailyHours
End If
End If
Next currentDay
Loop
End Sub

复制代码

cherry1314 · 发表于 2024-10-17 12:02

Excel_muke 发表于 2024-10-16 17:49
VBA实现

请问老师，我有很多个项目的工时，能否加一个循环语句把所有项目的工时都分配了

Excel_muke · 发表于 2024-10-17 17:51

cherry1314 发表于 2024-10-17 12:02
请问老师，我有很多个项目的工时，能否加一个循环语句把所有项目的工时都分配了

你是希望这个分配模板能多个项目使用吗？还是希望重设模板填入总工时、项目数，总工时自动分配所有项目？

Excel_muke · 发表于 2024-10-17 17:53

cherry1314 发表于 2024-10-17 12:02
请问老师，我有很多个项目的工时，能否加一个循环语句把所有项目的工时都分配了

刚才重新看了下，发现我题目理解错了，以我新发的这个为准

Sub DistributeHours()
Dim ws As Worksheet
Dim inputMonth As String
Dim totalHours As Long
Dim workDays As Long
Dim dayIndex As Long
Dim currentDay As Long
Dim remainingHours As Long
Dim dailyHours As Long
Dim monthStart As Date
Dim monthEnd As Date
Dim currentDate As Date
Dim workDayCount As Long
' 设置工作表
Set ws = ThisWorkbook.Sheets("Sheet1")
' 清空之前的记录
ws.Range("B3:B40").ClearContents
' 获取输入的月份和总工时
inputMonth = ws.Range("D2").Value
totalHours = ws.Range("F2").Value
' 检查输入格式是否正确
On Error Resume Next
monthStart = CDate(inputMonth & "/01/2024") ' 假设2024年，实际可以根据需要调整
On Error GoTo 0
If IsError(monthStart) Then
MsgBox "请输入正确的月份格式（如：10）。"
Exit Sub
End If
' 计算该月最后一天
monthEnd = DateSerial(Year(monthStart), Month(monthStart) + 1, 0)
' 计算工作日数量
workDayCount = 0
currentDate = monthStart
Do While currentDate <= monthEnd
If Weekday(currentDate) <> vbSunday Then ' 排除周日
workDayCount = workDayCount + 1
End If
currentDate = currentDate + 1
Loop
' 检查总工时是否超出每天8小时的限制
If totalHours > workDayCount * 8 Then
MsgBox "总工时过长，请重新分配！"
Exit Sub
End If
' 初始化每天的工作时间为0
For currentDay = 1 To workDayCount
ws.Cells(currentDay + 2, 2).Value = 0 ' B4开始记录
Next currentDay
' 分配工时
remainingHours = totalHours
Do While remainingHours > 0
For currentDay = 1 To workDayCount
If remainingHours = 0 Then Exit For
' 随机生成每天的工作时间，不超过8小时
dailyHours = Application.WorksheetFunction.Min(Int((remainingHours / (workDayCount - currentDay + 1)) * Rnd + 1), 8)
If ws.Cells(currentDay + 2, 2).Value + dailyHours <= 8 Then
ws.Cells(currentDay + 2, 2).Value = ws.Cells(currentDay + 2, 2).Value + dailyHours
remainingHours = remainingHours - dailyHours
Else
' 如果超出了最大值，选择一个较小的值
dailyHours = Application.WorksheetFunction.Min(remainingHours, 8 - ws.Cells(currentDay + 2, 2).Value)
If dailyHours > 0 Then
ws.Cells(currentDay + 2, 2).Value = ws.Cells(currentDay + 2, 2).Value + dailyHours
remainingHours = remainingHours - dailyHours
End If
End If
Next currentDay
Loop
End Sub

复制代码

cherry1314 · 发表于 2024-10-18 13:48

Excel_muke 发表于 2024-10-17 17:53
刚才重新看了下，发现我题目理解错了，以我新发的这个为准

老师，现在这个模版只是针对分配一个项目工时的，我有80多个项目的工时，就是能不能根据我有多少个项目，然后按照现在这个模式每个项目都自动分配，不知道我这样说，您是否能理解？

Excel_muke · 发表于 2024-10-18 15:59

cherry1314 发表于 2024-10-18 13:48
老师，现在这个模版只是针对分配一个项目工时的，我有80多个项目的工时，就是能不能根据我有多少个项目， ...

这种OK？

Sub DistributeHoursForMultipleProjects()
Dim ws As Worksheet
Dim inputMonth As String
Dim totalHours As Long
Dim workDayCount As Long
Dim currentDay As Long
Dim remainingHours As Long
Dim dailyHours As Long
Dim monthStart As Date
Dim monthEnd As Date
Dim currentDate As Date
Dim projectRow As Long
Dim lastRow As Long
Dim outputCol As Long
' 设置工作表
Set ws = ThisWorkbook.Sheets("Sheet1")
' 清空之前的记录
ws.Range("C5:AG40").ClearContents
' 获取输入的月份
inputMonth = ws.Range("A2").Value
' 获取最后一行
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 遍历每个项目
For projectRow = 5 To lastRow ' 假设项目从A5开始
' 获取对应项目的总工时
totalHours = ws.Cells(projectRow, 2).Value
' 检查输入格式是否正确
On Error Resume Next
monthStart = CDate(inputMonth & "/01/2024") ' 假设2024年，实际可以根据需要调整
On Error GoTo 0
If IsError(monthStart) Then
MsgBox "请输入正确的月份格式（如：10）在A2。"
Exit Sub
End If
' 计算该月最后一天
monthEnd = DateSerial(Year(monthStart), Month(monthStart) + 1, 0)
' 计算工作日数量
workDayCount = 0
currentDate = monthStart
Do While currentDate <= monthEnd
If Weekday(currentDate) <> vbSunday Then ' 排除周日
workDayCount = workDayCount + 1
End If
currentDate = currentDate + 1
Loop
' 检查总工时是否超出每天8小时的限制
If totalHours > workDayCount * 8 Then
ws.Cells(projectRow, 3).Value = "该项目总工时过长，请重新修改总工时!" ' 在C列提示错误信息
GoTo NextProject ' 跳过当前项目，继续下一个项目
End If
' 初始化每天的工作时间为0
outputCol = 3 ' C列开始输出
For currentDay = 1 To workDayCount
ws.Cells(projectRow, outputCol).Value = 0
outputCol = outputCol + 1
Next currentDay
' 分配工时
remainingHours = totalHours
Do While remainingHours > 0
outputCol = 3 ' 重置列位置
For currentDay = 1 To workDayCount
If remainingHours = 0 Then Exit For
' 随机生成每天的工作时间，不超过8小时
dailyHours = Application.WorksheetFunction.Min(Int((remainingHours / (workDayCount - currentDay + 1)) * Rnd + 1), 8)
If ws.Cells(projectRow, outputCol).Value + dailyHours <= 8 Then
ws.Cells(projectRow, outputCol).Value = ws.Cells(projectRow, outputCol).Value + dailyHours
remainingHours = remainingHours - dailyHours
Else
' 如果超出了最大值，选择一个较小的值
dailyHours = Application.WorksheetFunction.Min(remainingHours, 8 - ws.Cells(projectRow, outputCol).Value)
If dailyHours > 0 Then
ws.Cells(projectRow, outputCol).Value = ws.Cells(projectRow, outputCol).Value + dailyHours
remainingHours = remainingHours - dailyHours
End If
End If
outputCol = outputCol + 1
Next currentDay
Loop
NextProject:
Next projectRow
End Sub

复制代码

cherry1314 · 发表于 2024-10-22 08:28

Excel_muke 发表于 2024-10-18 15:59
这种OK？

非常ok，感谢老师

		自动登录	找回密码
密码			免费注册

[已解决] 工时分配工时

评分