使用VBA修改工作表单元格格式时，隐藏区域边框异常显示问题

我给客户开发Excel模型时，需要调整单个模型配色匹配客户品牌，为此做了个VBA工具，能按指定调色板调整整个工作簿的配色，包括隐藏区域（后续可能取消隐藏）。工具会遍历工作表已用单元格调整格式颜色，但遇到边框问题：

假设单元格$B$2隐藏且带边框，工具遍历$B$1时，会检测到$B$1的底部边框（实际属于$B$2）并修改颜色。因为$B$1没隐藏，修改后Excel会认为$B$1设置了底部边框，导致宏运行后$B$1的底部边框显示出来（原本应该保持隐藏）。

我知道Excel能识别边框所属的单元格，所以单元格隐藏时对应边框会隐藏，想知道这个属性是什么？或者有没有其他解决方案？

精简版代码如下：

Sub SwitchSheetColorScheme(ByVal strShtName as String)
Application.ScreenUpdating = False
Set rngSheetRange = GetActiveShtRange(strShtName) 'reduces sheet range to in-use range
Set rngNewColors = Range("cntrl_new_colorCode_rng") 'range of new color numeric values
Set rngOldColors = Range("cntrl_old_colorCode_rng") 'range of old color numeric values
  
For i = 1 To rngNewColors.Count
    For Each cell In rngSheetRange
        Dim ColorObjects As New Collection
            ColorObjects.Add cell.Borders(xlEdgeLeft)
            ColorObjects.Add cell.Borders(xlEdgeRight)
            ColorObjects.Add cell.Borders.Item(xlEdgeTop)
            ColorObjects.Add cell.Borders.Item(xlEdgeBottom)
                
        Dim attrib As String
        attrib = "Color"
            
          
            For x = 1 To ColorObjects.Count
                If CallByName(ColorObjects(x), attrib, VbGet) = rngOldColors(i, 1) Then
                    ColorObjects(x).Color = rngNewColors(i, 1)
                End If
            Next
     
        
        Set ColorObjects = Nothing

    Next
Next

Application.ScreenUpdating = True

End Sub

解决方案 #

1. 边框所属单元格的判断逻辑 #

Excel没有直接暴露“边框所属单元格”的属性，但可以通过位置逻辑判断边框实际归属：

• 顶部边框(xlEdgeTop)：属于当前单元格，若单元格所在行隐藏，边框会隐藏；
• 底部边框(xlEdgeBottom)：实际属于当前单元格的下一行（cell.Offset(1,0)）；
• 左侧边框(xlEdgeLeft)：属于当前单元格；
• 右侧边框(xlEdgeRight)：实际属于当前单元格的右侧单元格（cell.Offset(0,1)）。

基于这个逻辑，修改边框颜色前先检查所属单元格的状态，避免修改隐藏单元格对应的可见单元格边框。

2. 修改后的代码示例 #

Sub SwitchSheetColorScheme(ByVal strShtName As String)
    Application.ScreenUpdating = False
    Dim rngSheetRange As Range
    Dim rngNewColors As Range, rngOldColors As Range
    Dim i As Integer, x As Integer
    Dim cell As Range
    Dim ColorObjects As New Collection
    Dim attrib As String
    Dim borderOwner As Range
    
    Set rngSheetRange = GetActiveShtRange(strShtName)
    Set rngNewColors = Range("cntrl_new_colorCode_rng")
    Set rngOldColors = Range("cntrl_old_colorCode_rng")
    
    attrib = "Color"
    
    For i = 1 To rngNewColors.Count
        For Each cell In rngSheetRange
            Set ColorObjects = New Collection
            ColorObjects.Add cell.Borders(xlEdgeLeft), Key:="Left"
            ColorObjects.Add cell.Borders(xlEdgeRight), Key:="Right"
            ColorObjects.Add cell.Borders(xlEdgeTop), Key:="Top"
            ColorObjects.Add cell.Borders(xlEdgeBottom), Key:="Bottom"
            
            For x = 1 To ColorObjects.Count
                ' 判定边框实际所属单元格
                Select Case ColorObjects(x).Key
                    Case "Left", "Top"
                        Set borderOwner = cell
                    Case "Right"
                        Set borderOwner = cell.Offset(0, 1)
                    Case "Bottom"
                        Set borderOwner = cell.Offset(1, 0)
                End Select
                
                ' 匹配颜色且所属单元格符合条件时才修改
                If CallByName(ColorObjects(x), attrib, VbGet) = rngOldColors(i, 1) Then
                    ' 所属单元格可见，或属于已用范围（后续取消隐藏需生效）则修改
                    If Not (borderOwner.EntireRow.Hidden Or borderOwner.EntireColumn.Hidden) Or _
                        Not Intersect(borderOwner, rngSheetRange) Is Nothing Then
                        ColorObjects(x).Color = rngNewColors(i, 1)
                    End If
                End If
            Next x
            
            Set ColorObjects = Nothing
        Next cell
    Next i
    
    Application.ScreenUpdating = True
End Sub

3. 额外优化建议 #

• 遍历前可先过滤完全隐藏的行/列，减少无效循环；
• 可以先收集所有需要修改的边框信息，再批量执行修改，提升运行效率。

内容的提问来源于stack exchange，提问作者geekeel