包含特定百分比值的VBA單元格格式

Question

我有VBA代碼，可在單元格中循環查找百分比值，並在單擊復選框時相應地突出顯示它們。
我有2個復選框GreaterThan100 ， LessThan0 。

Private Sub GreaterThan100_Click()
    Dim lr As Long
    lr = range("A" & Rows.Count).End(xlUp).Row
    Dim c As range
    Dim rng As range
    Set rng = range("G3:G30" & lr)
    Dim find As Long
    find = 1
    Application.ScreenUpdating = False
    If GreaterThan100.Value = True Then
    For Each c In rng
        If c >= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlue
           .LineStyle = xlContinuous
           .Weight = xlThick
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    Else
    For Each c In rng
        If c >= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlack
           .LineStyle = xlNone
           .Weight = xlThin
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    End If
End Sub

Private Sub LessThan0_Click()
    Dim lr As Long
    lr = range("A" & Rows.Count).End(xlUp).Row
    Dim c As range
    Dim rng As range
    Set rng = range("G3:G30" & lr)
    Dim find As Long
    find = 0
    Application.ScreenUpdating = False
    If LessThan0.Value = True Then
    For Each c In rng
        If c <= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlue
           .LineStyle = xlContinuous
           .Weight = xlThick
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    Else
    For Each c In rng
        If c <= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlack
           .LineStyle = xlNone
           .Weight = xlThin
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    End If
End Sub

兩種代碼都可以工作，但是LessThan0花費的時間明顯大於GreaterThan100 。 關於如何使其運行更快的任何建議？ 關於改進這兩種方法的建議也將有所幫助！

Answer 1

首先，在計算后檢查rng變量中的最終值。 通常，如果要考慮單元格A3至G30，則范圍應為“ A3：G30” 。 語句lr = range（“ A”＆Rows.Count）.End（xlUp）.Row和Set rng = range（“ G3：G30”＆lr）給人的印象是單元格區域的格式不正確。 但是，我的懷疑可能只是一個錯誤的警報，因為無論您說什么，您的要求都還不清楚。

其次，為簡潔起見，將代碼的以下部分更改為如下所示

Application.ScreenUpdating = False
If LessThan0.Value = True Then
    For Each c In rng
        If c <= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlue
           .LineStyle = xlContinuous
           .Weight = xlThick
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    Else
    For Each c In rng
        If c <= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlack
           .LineStyle = xlNone
           .Weight = xlThin
          End With
        End If
    Next c
Application.ScreenUpdating = True
End If

Application.ScreenUpdating = False
For Each c In rng
   If c <= find
     c.Select
     With Selection.Borders
       .Color = IIf(LessThan0.Value = True, vbBlue, vbBlack) 
       .LineStyle = IIf(LessThan0.Value = True, xlContinuous, xlNone) 
       .Weight = IIf(LessThan0.Value = True, xlThick, xlThin)  
     End With
   End If
Next c
Application.ScreenUpdating = True

此外，可以通過將值GreaterThan100.value和LessThan0.value用作該單個子例程的參數，將這兩個子例程合並為一個