根据排班表数据填写到I列，J列为结果，如何使用宏代码实现，求大佬帮忙

ykcbf1100

看着简单，其实比较复杂，条件很多，不只是白班和夜班问题。

longwin

请测试......

凌云漂流瓶2014

gwjkkkkk 发表于 2024-6-22 20:51
没看清题，请参考。。。

启动宏了，但还是提示阻止宏启动

gwjkkkkk

凌云漂流瓶2014 发表于 2024-6-22 21:04
启动宏了，但还是提示阻止宏启动

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&, dte As Date, dte1 As Date, strDay$, isFlag As Boolean
   
    Application.ScreenUpdating = False
   
    br = Worksheets(2).[A1].CurrentRegion.Value
    ar = [A1].CurrentRegion.Value
   
    For i = 2 To UBound(ar)
        dte = CDate(Format(ar(i, 7), "yyyy-m-d"))
        dte1 = CDate(Format(ar(i, 7), "HH:MM:SS"))
        If dte1 >= CDate("07:50:00") And dte1 <= CDate("19:49:59") Then strDay = "白班" Else strDay = "夜班"
        isFlag = False
        For j = 1 To UBound(br)
            If dte >= br(j, 1) And dte <= br(j, 2) Then
                If CBool(InStr(br(j, 4), ar(i, 6))) And CBool(InStr(br(j, 5), ar(i, 8))) And br(j, 3) = strDay Then
                    ar(i, 9) = br(j, UBound(br, 2))
                    isFlag = True
                    Exit For
                End If
            End If
        Next j
        If isFlag = False Then ar(i, 9) = Empty
    Next i
        
    [A1].Resize(UBound(ar), UBound(ar, 2)) = ar
    Application.ScreenUpdating = True
    Beep
End Sub

凌云漂流瓶2014

gwjkkkkk 发表于 2024-6-22 20:51
没看清题，请参考。。。

可以了，能帮忙注释一下代码吗

凌云漂流瓶2014

longwin 发表于 2024-6-22 21:01
请测试......

07:50:00-19:49:59为白班，19:50:00-07:49:59为夜班    能帮忙注释一下代码吗

gwjkkkkk

凌云漂流瓶2014 发表于 2024-6-22 21:49
可以了，能帮忙注释一下代码吗

为你写的那么多，不评分一下吗？
Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, dte As Date, dte1 As Date, strDay$, isFlag As Boolean
   
    Application.ScreenUpdating = False
   
    br = Worksheets(2).[A1].CurrentRegion.Value '在工作表"排班表"中取数据
    ar = [A1].CurrentRegion.Value '在当前工作表也就"明细表"中取数
   
    For i = 2 To UBound(ar)
        '为便于比较将测试时间段转换二种时间格式，便于比较
        dte = CDate(Format(ar(i, 7), "yyyy-m-d"))
        dte1 = CDate(Format(ar(i, 7), "HH:MM:SS"))
        '为设定的第二种类型的日期进行判断，因为待比较时间为文本，需将文本转成日期格式进行比较，通过判断确认时间段是否为白班或夜班
        If dte1 >= CDate("07:50:00") And dte1 <= CDate("19:49:59") Then strDay = "白班" Else strDay = "夜班"
        isFlag = False '对布尔值进行设定，为什么设定，就是初始表格I列未清除
        For j = 1 To UBound(br)
            If dte >= br(j, 1) And dte <= br(j, 2) Then '满足这个时间段再进行下一步判断
                '再满足这三个条件为全部满足，将数据写入对应的I栏
                If CBool(InStr(br(j, 4), ar(i, 6))) And CBool(InStr(br(j, 5), ar(i, 8))) And br(j, 3) = strDay Then
                    ar(i, 9) = br(j, UBound(br, 2))
                    isFlag = True '将布尔值设定为是
                    Exit For '因为已满足，直接退出循环，不满足再循环
                End If
            End If
        Next j
        '最后如果没有满足的那么布尔值是否，则对应的I栏相关数据进行清除，为什么清除，有可能该位置有数据。
        If isFlag = False Then ar(i, 9) = Empty
    Next i
        
    [A1].Resize(UBound(ar), UBound(ar, 2)) = ar '最后再写入工作表
    Application.ScreenUpdating = True
    Beep
End Sub

凌云漂流瓶2014

gwjkkkkk 发表于 2024-6-22 22:09
为你写的那么多，不评分一下吗？
Option Explicit
Sub TEST2()

谢谢，写得很详细

longwin

代码已增加注释.....

凌云漂流瓶2014

gwjkkkkk 发表于 2024-6-22 19:54
Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&, dte As Date, isFlag As Boolean

根据区域表数据填写到K列，M列为结果，如何使用宏代码实现，求大佬帮忙,把代码跟表格里的代码写一起，谢谢