显示与隐藏问题

jx928867128

显示与隐藏问题.zip (18.52 KB, 下载次数: 4)

2024-4-2 19:13 上传

点击文件名下载附件

ykcbf1100

你那二行是在一个单元格中的。你如果真的分成二行的话，应该是可以做到吧。

gwjkkkkk

有颜色的显示和隐藏，按行还是按列，没看懂？？？

jx928867128

gwjkkkkk 发表于 2024-4-2 19:43
有颜色的显示和隐藏，按行还是按列，没看懂？？？

就是汇总表中每个单元格中上一行是显示课程名，下一行是显示教师名，需要程序把每个单元格中的课程名全部隐藏或全部恢复出来

jx928867128

ykcbf1100 发表于 2024-4-2 19:34
你那二行是在一个单元格中的。你如果真的分成二行的话，应该是可以做到吧。

谢谢老师的再次关注与回贴。

gwjkkkkk

直接隐藏估计不行，换一种将课程字体颜色改成白色。。。。

ykcbf1100

jx928867128 发表于 2024-4-2 19:47
就是汇总表中每个单元格中上一行是显示课程名，下一行是显示教师名，需要程序把每个单元格中的课程名全部 ...

你哪里知道有这个显示方式？

jx928867128

ykcbf1100 发表于 2024-4-2 19:58
你哪里知道有这个显示方式？

排课软件里有这种功能，所以就想知识VBA是不是也能实现

jx928867128

gwjkkkkk 发表于 2024-4-2 19:58
直接隐藏估计不行，换一种将课程字体颜色改成白色。。。。

谢谢老师的再次关注与回贴，如果无法实现就不麻烦您了

liulang0808

Sub 矩形2_Click()
    Application.ScreenUpdating = False
    kc = "英语|德育|语文|政治|历史|地理|数学|体育|化学|生物|物理"
    With CreateObject("vbscript.regexp")
        .Global = True
        For Each Rng In ActiveSheet.UsedRange
            .Pattern = kc
            If .test(Rng.Value) Then
                .Pattern = "[一-龥]+"
                str1 = .Execute(Rng.Value)(0)
                str2 = .Execute(Rng.Value)(1)
                If InStr(kc, str1) = 0 Then
                    Rng.Value = str2 & Chr(10) & str1
                Else
                    Rng.Value = str1 & Chr(10) & str2
                End If
            End If
        Next Rng
    End With
    Rows("7:28").RowHeight = 27
    Application.ScreenUpdating = True
End Sub
Sub 矩形1_Click()
    Application.ScreenUpdating = False
    kc = "英语|德育|语文|政治|历史|地理|数学|体育|化学|生物|物理"
    With CreateObject("vbscript.regexp")
        .Global = True
        For Each Rng In ActiveSheet.UsedRange
            .Pattern = kc
            If .test(Rng.Value) Then
                .Pattern = "[一-龥]+"
                str1 = .Execute(Rng.Value)(0)
                str2 = .Execute(Rng.Value)(1)
                If InStr(kc, str1) = 0 Then
                    Rng.Value = str1 & Chr(10) & Chr(10) & str2
                Else
                    Rng.Value = str2 & Chr(10) & Chr(10) & str1
                End If
            End If
        Next Rng
    End With
    Rows("7:28").RowHeight = 27
    Application.ScreenUpdating = True
End Sub