[已解决]表格如何按照人员每天自动排班，过滤日期呢，和双休日单人双人设置attach_img

lj3543711 · 发表于 2021-12-27 13:53

本帖最后由 lj3543711 于 2021-12-27 14:45 编辑

表格如何按照人员每天自动排班，过滤日期呢，和双休日单人双人设置

设置双休双人和过滤日期.png

路过的大佬麻烦给小的看下

不知如何设置过滤日期和双休日单人和双人设置

在线的大佬麻烦您看看

公司人员排班表.zip (13.27 KB, 下载次数: 10)

林木水 · 发表于 2021-12-27 14:34

没看明白你的需求最终的效果是怎么样？

lj3543711 · 发表于 2021-12-27 14:42

林木水发表于 2021-12-27 14:34
没看明白你的需求最终的效果是怎么样？

人员按照顺序推进

林木水 · 发表于 2021-12-27 15:17

lj3543711 发表于 2021-12-27 14:42
人员按照顺序推进

这样就比较清楚了，稍等

lj3543711 · 发表于 2021-12-27 15:23

林木水发表于 2021-12-27 15:17
这样就比较清楚了，稍等

感谢您，非常感谢

sam-wang · 发表于 2021-12-27 15:48

这个最佳答案由 sam-wang 给出，感谢 sam-wang 的回答。

单击隐藏图章

本帖最后由 sam-wang 于 2021-12-27 15:55 编辑

Sub test()
Dim Arr, Brr, xD, StD As Date, T, i&, n%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range("a1:h" & Cells(Rows.Count, 1).End(3).Row)
Brr = Range("n3:n" & Cells(Rows.Count, 14).End(3).Row)
For i = 1 To UBound(Brr): xD(Brr(i, 1)) = "": Next
Brr = Range("k2:k" & Cells(Rows.Count, 11).End(3).Row)
StD = Range("L3"): n = 1
For i = 3 To UBound(Arr) Step 2
For j = 2 To 8
      If xD.Exists(StD) Then Cells(i - 1, j) = StD: StD = StD + 1: GoTo 99
      Cells(i - 1, j) = StD
      If j < 7 Then
         Cells(i, j) = Brr(n, 1)
      Else
         T = Brr(n, 1): n = n + 1: n = (n - 1) Mod UBound(Brr) + 1
         Cells(i, j) = T & "," & Brr(n, 1)
      End If
      StD = StD + 1: n = n + 1: n = (n - 1) Mod UBound(Brr) + 1
99: Next
Next
End Sub

sam-wang · 发表于 2021-12-27 15:50

請測試看看，謝謝

lj3543711 · 发表于 2021-12-27 16:06

sam-wang 发表于 2021-12-27 15:50
請測試看看，謝謝

测试啦，双休日设置- 双人没有问题，单人不行

excel用户1116 · 发表于 2021-12-27 16:12

本帖最后由 excel用户1116 于 2021-12-27 16:21 编辑

公司人员排班表.zip (15.18 KB, 下载次数: 2)

林木水 · 发表于 2021-12-27 16:42

Sub 排班()
'日期
Dim i As Integer, j As Integer, k As Integer, Arr, k1 As Integer
Arr = Range("k2:k" & Cells(65536, "k").End(xlUp).Row)
If Cells(65536, "k").End(xlUp).Row = 1 Then MsgBox "无值班人员"
For i = 2 To 18 Step 2
For j = 2 To 8
Cells(i, j) = Format(Cells(3, "l").Value + k, "yyyy-m-d")
If Range("n:n").Find(Cells(i, j).Value, lookat:=xlWhole) Is Nothing Then
If Cells(3, "m").Value = "单人" Then
k1 = k1 + 1
If k1 = UBound(Arr, 1) Then
Cells(i, j).Offset(1, 0) = Arr(UBound(Arr, 1), 1)
k1 = 0
Else
Cells(i, j).Offset(1, 0) = Arr(k1, 1)
End If
Else
'双人
If j <= 6 Then
k1 = k1 + 1
If k1 = UBound(Arr, 1) Then
Cells(i, j).Offset(1, 0) = Arr(UBound(Arr, 1), 1)
k1 = 0
Else
Cells(i, j).Offset(1, 0) = Arr(k1, 1)
End If
Else
k1 = k1 + 1
If k1 = UBound(Arr, 1) Then
Cells(i, j).Offset(1, 0) = Arr(UBound(Arr, 1), 1) & "," & Arr(1, 1)
k1 = 1
Else
If k1 + 1 = UBound(Arr, 1) Then
Cells(i, j).Offset(1, 0) = Arr(k1, 1) & "," & Arr(k1 + 1, 1)
k1 = 0
Else
Cells(i, j).Offset(1, 0) = Arr(k1, 1) & "," & Arr(k1 + 1, 1)
k1 = k1 + 1
End If
End If
End If
End If
Else
Cells(i, j).Offset(1, 0) = ""
End If
k = k + 1
Next j
Next i
End Sub

复制代码

以上，见附件

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