项目考勤的随机分配

恒信人才

已知各项目月度汇总考勤天数，如何把各人员在各项目中的出勤天数随机分配每日考勤表中去！

liulang0808

简单模拟一个，不完善，供参考

恒信人才

liulang0808 发表于 2023-5-6 16:20
简单模拟一个，不完善，供参考

非常感谢版主！我测试了一下 ，非常不错，太牛了！还些问题，麻烦版主，再帮我看一下。

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    If [c2] = 12 Then
        d = 31
    Else
        d = Day(CDate([c1] & "-" & [c2] + 1 & "-1") - 1)
    End If
    [m3:aq4].ClearContents
    [m3:aq4].Interior.ColorIndex = xlNone
    For j = 1 To d
        Cells(3, j + 12) = j
        Cells(4, j + 12) = Format(CDate([c1] & "-" & [c2] & "-" & j), "AAA")
        If Cells(4, j + 12) = "周日" Then Cells(4, j + 12).Interior.ColorIndex = 3
    Next j
    ActiveSheet.UsedRange.Offset(4, 11).ClearContents
    ActiveSheet.UsedRange.Offset(4, 11).Interior.ColorIndex = xlNone
    arr = ActiveSheet.UsedRange
    y = 12 + d
    For j = 5 To UBound(arr)
        If Len(arr(j, 2)) > 0 Then
            For i = 3 To 9
                For k = 1 To Val(arr(j, i))
l1:
                    x = WorksheetFunction.RandBetween(13, y)
                    If Len(arr(j, x)) = 0 And arr(4, x) <> "周日" Then
                        Z = WorksheetFunction.Max(13, x - 2)
                        w = WorksheetFunction.Min(y, x + 2)
                        n = 0
                        For k1 = Z To w
                            If arr(j, k1) = arr(4, i) Then
                                n = n + 1
                            End If
                        Next k1
                        If n >= 2 Then GoTo l1
                        arr(j, x) = arr(4, i)
                        Cells(j, x) = arr(4, i)
                        Cells(j, x).Interior.ColorIndex = arr(4, i) + 2
                    Else
                        GoTo l1
                    End If
                Next k
            Next i

        End If
    Next j
    ActiveSheet.UsedRange = arr
    Application.ScreenUpdating = True
End Sub

liulang0808

模拟供参考。。。。。。。

恒信人才

liulang0808 发表于 2023-5-6 20:11
模拟供参考。。。。。。。

下载测试了，好用。版主太厉害了！谢谢！
还有一个问题：表头C3单元格（*年*月份项目考勤汇总表），表头M1单元格（*年*月份项目考勤表），不会随C1(年份）  ,C2（月份）变动而变动。

liulang0808

恒信人才 发表于 2023-5-8 08:21
下载测试了，好用。版主太厉害了！谢谢！
还有一个问题：表头C3单元格（*年*月份项目考勤汇总表），表头 ...

公式设置一下就可以了吧？

恒信人才

liulang0808 发表于 2023-5-8 13:23
公式设置一下就可以了吧？

公式设置好 ，点 “按钮” 后 ，就会被 清除掉了。

liulang0808

。。。。。。。。。

恒信人才

liulang0808 发表于 2023-5-8 16:18
。。。。。。。。。

非常好用！感谢！！