请高手帮助更改一下代码，谢谢！

ysjjess

请把遍历整个工作表的代码更改为A1：L3000，这样速度快很多，整个工作表太慢了，谢谢！

已经实现，代码如下：Sub HideUnselectedRange()
    Dim SelectedRange As Range
    Dim WholeRange As Range
    Dim Cell As Range

    ' 获取用户选择的区域
    Set SelectedRange = Selection

    ' 假设指定的区域为 A1:Z1000
    Set WholeRange = Range("$A$1:$L$1000")

    For Each Cell In WholeRange
        If Not Intersect(Cell, SelectedRange) Is Nothing Then
            ' 保留选中区域的格式不变
        Else
            ' 将未选择区域的字体颜色设置为白色，边框设置为无边框
            Cell.Font.Color = RGB(255, 255, 255)
            Cell.Borders.LineStyle = xlNone
        End If
    Next Cell

    ' 打印当前工作表

    ActiveSheet.PrintOut
End Sub

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub SetUnselectedFormat()
   
2.     Set Rng = [A1:L3000]
   
3.     Rng.Font.Color = vbRed
   
4.     Rng.Borders.LineStyle = xlNone
   
5. End Sub
   

复制代码

ysjjess

ykcbf1100 发表于 2024-8-15 14:44
参与一下。。。

谢谢！但是你这个只是单独的，我还要原来那个有选择区域不变的代码，我原来那个意思就是选择题一部分，运行后选择的那部分不改变，主要是遍历整个表，很费资源，我就想指定遍历A1：L3000，其他不变

ysjjess

经过各种问，终于搞定，先选择要打印的区域，运行代码，代码会把未选择的区域字体颜色设置为白色，边框为无，这样就留下选择区域内容正常显示，位置不变，打印就行了，有用得着的自己测试，代码如下：Sub HideUnselectedRange()
    Dim SelectedRange As Range
    Dim WholeRange As Range
    Dim Cell As Range

    ' 获取用户选择的区域
    Set SelectedRange = Selection

    ' 假设指定的区域为 A1:Z1000
    Set WholeRange = Range("$A$1:$L$1000")

    For Each Cell In WholeRange
        If Not Intersect(Cell, SelectedRange) Is Nothing Then
            ' 保留选中区域的格式不变
        Else
            ' 将未选择区域的字体颜色设置为白色，边框设置为无边框
            Cell.Font.Color = RGB(255, 255, 255)
            Cell.Borders.LineStyle = xlNone
        End If
    Next Cell

    ' 打印当前工作表

    ActiveSheet.PrintOut
End Sub