在 G1 > G4:G76 的值处画一条横跨整行的边界线

Question

我在 G1 中有一个动态值（每 5 分钟更新一次）。

还有从 G4 到 G76 的动态值（每 5 分钟更新一次）。

我需要在整行上画一条边界线，其中 G1 > G4:G76 （范围）

由于 G42 中的值大于 G1，因此边界线会从 B42 绘制到 L42，但是该边界线会根据 G1 中的值变化向上或向下移动

Sub Macro1()
    
Dim r As Range, r2 As Range
Dim ws As Worksheet
    
For Each ws In ThisWorkbook.Worksheets
    With ws
        Set r = .Range("G1:G76" & .Range("G" & Rows.Count).End(xlUp).Row)
        All_Borders_Off ws
        For Each r2 In r
            If r2.Value > G1 Then
                With r2.Offset(, -5).Resize(, 11)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .BorderAround Weight:=xlThin
                End With
            End If
        Next
    End With
Next
End Sub


Sub All_Borders_Off(ws As Worksheet)
With ws.UsedRange
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End Sub

代码边框所有行，无论值> G1，但这就是我需要的。

Answer 1

如果您的模块顶部有

Option Explicit

，您可以看到

G1

被视为变量（未声明...），被视为

vbNullSTring

...然后，使用

Union Range

，正如我的评论中所建议的，将大大提高代码速度。请使用下一个改编代码：

Sub MacroPlaceBorders()
  Dim r As Range, r2 As Range, URange As Range, ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    With ws
        Set r = .Range("G1:G" & .Range("G" & rows.count).End(xlUp).row)
        All_Borders_Off ws
        For Each r2 In r
            If r2.Value > ws.Range("G1").Value Then
               addToRange URange, r2.Offset(, -5).Resize(, 11)
            End If
        Next
    End With
    If Not URange Is Nothing Then
           'URange.Borders(xlInsideHorizontal).Weight = xlThin
           URange.BorderAround Weight:=xlThin
           Set URange = Nothing 'preparing it for the next sheet
    End If
 Next
End Sub

Sub addToRange(rngU As Range, rng As Range)
    If rngU Is Nothing Then
        Set rngU = rng
    Else
        Set rngU = Union(rngU, rng)
    End If
End Sub

它使用您现有的子程序删除所有现有的边框线。