判断教师上午和下午有课还是无课

foreversun

有课无课教师课表.zip (78.18 KB, 下载次数: 18)

2024-12-19 16:47 上传

点击文件名下载附件

根据教师课表，判断教师上午和下午有课还是无课 （上午 第1节-第5节 ，下午第6节-第9节）上午或下午只要有一节课就判断为有课 每个年级有100多个任课教师，请教有没有办法快速列出

土匪远

基本思路是逆透视后再透视，中间调整下：

let
    源 = Excel.CurrentWorkbook(){[Name="表1_2"]}[Content],
    向下填充 = Table.FillDown(源,{"姓名"}),
    去除空行 = Table.SelectRows(向下填充, each ([节次] <> "")),
    逆透视 = Table.UnpivotOtherColumns(去除空行, {"节次", "姓名"}, "属性", "值"),
    判断 = Table.AddColumn(逆透视, "上下午", each if List.ContainsAny({"1".."5"},Text.ToList([节次])) then "上午" else "下午"),
    合并 = Table.CombineColumns(判断,{"属性", "上下午"},Combiner.CombineTextByDelimiter("", QuoteStyle.None),"已合并"),
    判断1 = Table.Group(合并,{"姓名","已合并"},{"a",each if Text.Combine([值])="" then "无课" else "有课"}),
    再透视 = Table.Pivot(判断1, List.Distinct(判断1[已合并]), "已合并", "a"),
    排序 = Table.ReorderColumns(再透视,{"姓名", "星期一上午", "星期一下午", "星期二上午", "星期二下午", "星期三上午", "星期三下午", "星期四上午", "星期四下午", "星期五上午", "星期五下午"})
in
    排序

minchar

let
    源 = Excel.CurrentWorkbook(){[Name="表1"]}[Content],
    向下填充姓名 = Table.FillDown(源,{"姓名"}),
    删除第一列空值 = Table.SelectRows(向下填充姓名,each [列1] <> null),
    将课替换为上下午 = Table.ReplaceValue(删除第一列空值,null,null,(x,y,z)=>if x < "第6节" then "上午" else "下午",{"列1"}),
    逆透视星期列 = Table.UnpivotOtherColumns(将课替换为上下午, {"列1", "姓名"}, "属性", "值"),
    合并下午与星期 = Table.CombineColumns(逆透视星期列,{"属性", "列1"},Text.Combine,"已合并"),
    透视列星期与上下午 = Table.Pivot(合并下午与星期, List.Distinct(合并下午与星期[已合并]), "已合并", "值", List.NonNullCount),
    课数为0替换为没课 = Table.ReplaceValue(透视列星期与上下午,null,null,(x,y,z)=> if x=0 then "没课" else "有课",{"星期一上午", "星期二上午", "星期四上午", "星期三上午", "星期五下午", "星期三下午", "星期五上午", "星期一下午", "星期二下午"}),
    重排序的列 = Table.ReorderColumns(课数为0替换为没课,{"姓名", "星期一上午", "星期一下午", "星期二上午", "星期二下午", "星期三上午", "星期三下午", "星期四上午", "星期五上午", "星期五下午"})
in
    重排序的列

3190496160

vba代码很好解决的问题

3190496160

Sub 判断有无课程()
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "课程表为空，请先导入数据！": End
    ar = .Range("a1:g" & r)
    ReDim br(1 To UBound(ar), 1 To 11)
    For i = 1 To UBound(ar) Step 10
        lh = 1
        If i = 1 Then
            xh = 2
            ks = xh
        Else
            xh = i
            ks = xh + 1
        End If
        If ar(xh, 7) <> "" Then
            n = n + 1
            br(n, 1) = ar(xh, 7)
            For j = 2 To 6
                sl = 0
                For s = ks To ks + 4
                    If ar(s, j) <> "" Then
                        sl = sl + 1
                    End If
                Next s
                lh = lh + 1
                If sl > 0 Then
                    br(n, lh) = "有课"
                Else
                    br(n, lh) = "无课"
                End If
                sl = 0
                For s = ks + 5 To ks + 8
                    If ar(s, j) <> "" Then
                        sl = sl + 1
                    End If
                Next s
                lh = lh + 1
                If sl > 0 Then
                    br(n, lh) = "有课"
                Else
                    br(n, lh) = "无课"
                End If
            Next j
        End If
    Next i
    rs = .Cells(Rows.Count, 11).End(xlUp).Row
    If rs >= 8 Then .Range("k8:u" & rs) = Empty
    .Cells(8, 11).Resize(n, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub

3190496160

有课无课教师课表.rar (32.93 KB, 下载次数: 3)

2024-12-20 10:11 上传

点击文件名下载附件

wdx223

kirete

cnmlgb9998

是这个效果吗？？？？？？？？？？？？

foreversun

土匪远 发表于 2024-12-19 19:26
基本思路是逆透视后再透视，中间调整下：

let

谢谢 效果与我想要的一样。