[已解决]制作排班表

wanao2008

Sub wanao()
    Dim Bai, Ye, Dai, Xq As Integer
    Dim Ban, Nian, jShu As Integer, rShu As Integer
    Dim BB(1 To 3, 1 To 366), jS1 As Integer, jS2 As Integer
    With Sheet1
        Ban = .Range("D1:F1")
        Bai = .Range("D2:D" & .Range("D100").End(xlUp).Row)
        Ye = .Range("E2:E" & .Range("E100").End(xlUp).Row)
        Dai = .Range("F2:F" & .Range("F100").End(xlUp).Row)
        Nian = .[a2]
    End With
    jS1 = 0
    jS2 = 0
    rShu = 0
    '白班 + 带班
    For x = 1 To 366
        jS1 = jS1 + 1
        BB(1, x) = Bai(jS1, 1)
        If jS1 = UBound(Bai, 1) Then jS1 = 0
        jS2 = jS2 + 1
        BB(3, x) = Dai(jS2, 1)
        If jS2 = UBound(Dai, 1) Then jS2 = 0
    Next
    Xq = Weekday(VBA.DateSerial(Nian, 1, 1), vbMonday)
    jS1 = 0
    jS2 = 0
    '夜班
    For x = 1 To 366
        If Xq <= 5 Then
            jS1 = jS1 + 1
            BB(2, x) = Ye(jS1, 1)
            If jS1 = UBound(Ye, 1) Then jS1 = 0
            Xq = Xq + 1
        Else
            jS2 = jS2 + 1
            BB(2, x) = Ye(jS2, 1)
            If jS2 = UBound(Ye, 1) Then jS2 = 0
            Xq = Xq + 1
            If Xq > 7 Then Xq = 1
        End If
    Next
    '将数据放入12个月里
    For m = 1 To 12
        Set mywb = Worksheets(WorksheetFunction.Text(VBA.DateSerial(Nian, m, 1), "[DBNum1]m月份"))
        maxday = VBA.Day(VBA.DateSerial(Nian, m + 1, 0))
        With mywb
            .Range("D1:F1") = Ban

            For x = 1 To maxday
                zday = zday + 1
                .Cells(x + 1, 4) = BB(1, zday)
                .Cells(x + 1, 5) = BB(2, zday)
                .Cells(x + 1, 6) = BB(3, zday)
            Next
        End With
   Next
End Sub

cunfu2010

wanao2008 发表于 2016-4-12 21:22
Sub wanao()
    Dim Bai, Ye, Dai, Xq As Integer
    Dim Ban, Nian, jShu As Integer, rShu As Intege ...

感谢，能改成：
夜班和带班轮转，
白班周一至周五轮转，周六周日单独轮转：即这周是第一值周六、第二值周日，到下周第三值周六、第四值周日，依次类推，最后一人值完第一人接着
最好给个注，谢谢！！！

金樽空对月

cunfu2010 发表于 2016-4-11 11:59
你好，我试了，在月份工作表里，带班排到夜班前面去了，如何修改？带班要放到夜班后面。谢谢

你可以白班排一次，夜班排一次，另外你是只在本月内轮排，还是跨月轮排呢？

cunfu2010

金樽空对月 发表于 2016-4-12 22:23
你可以白班排一次，夜班排一次，另外你是只在本月内轮排，还是跨月轮排呢？

跨月。最好在下月排的时候能接现在这个月，按顺序往下排

金樽空对月

cunfu2010 发表于 2016-4-12 22:31
跨月。最好在下月排的时候能接现在这个月，按顺序往下排

刚看到问题已经解决了。

cunfu2010

金樽空对月 发表于 2016-4-12 22:33
刚看到问题已经解决了。

那还是要谢谢你的，多学了知识

cunfu2010

wanao2008 发表于 2016-4-12 21:22
Sub wanao()
    Dim Bai, Ye, Dai, Xq As Integer
    Dim Ban, Nian, jShu As Integer, rShu As Intege ...

你好，麻烦问一下：如果D2中输入4，则激发一个事件：即排今年4月份的班。代码如何写？谢谢

zjdh

凑个热闹
排班表.rar (17.12 KB, 下载次数: 26)

2016-4-13 18:43 上传

点击文件名下载附件

wanao2008

cunfu2010 发表于 2016-4-12 23:17
你好，麻烦问一下：如果D2中输入4，则激发一个事件：即排今年4月份的班。代码如何写？谢谢

有几个问题：
1、D2已被“白班”占住，应该不能再输入其它内容吧？我看放置在A3单元格比较好；
2、如果只排某一个月的，那人名顺序是从1月开始，还是就从要排的月开始？

cunfu2010

zjdh 发表于 2016-4-13 18:41
凑个热闹

感谢！！！