如果單元格大于上限或小于下限，我正在嘗試以編程方式突出顯示選定范圍內的單元格。
我已經能夠突出顯示整個選擇，但是在嘗試突出顯示超出限制值的特定單元格值時，我最終收到錯誤 7。有關如何糾正此問題的任何建議？
下面的代碼和下面的資料影像也是：
Sub Data_Prep()
'Identify Outliers
'Specify Dims.....
Dim ws_instruction As Worksheet
Dim ws_data As Worksheet
Dim ws_output As Worksheet
Dim selectedRng As Range
Dim record_cell As Variant
Dim Upper_limit As Variant
Dim Lower_limit As Variant
Dim AnswerYes As String
Dim AnswerNo As String
'Ascribe worksheets
Set ws_instruction = ThisWorkbook.Worksheets("Instruction Sheet")
Set ws_data = ThisWorkbook.Worksheets("Data Sheet")
Set ws_output = ThisWorkbook.Worksheets("Output Sheet")
Set selectedRng = Application.Selection
'Error handling to capture Cancel key.
On Error GoTo errHandler
'Define range.
Set selectedRng = Application.InputBox("Range", , selectedRng.Address, Type:=8)
record_cell = selectedRng.Address(ReferenceStyle:=xlA1, _
RowAbsolute:=False, ColumnAbsolute:=False)
Cells(1, 9).Value = record_cell
Cells(1, 10).Value = record_cell
'Format Output Information
ws_output.Cells(4, 1).Value = "Upper Limit"
ws_output.Cells(5, 1).Value = "Lower Limit"
'Limits for the Selected Array
Upper_limit = 52
Lower_limit = 13
ws_output.Cells(4, 2).Value = Upper_limit
ws_output.Cells(5, 2).Value = Lower_limit
On Error GoTo errHandler
'Do something to the selected or input range.
With selectedRng.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535 'Same as RGB(255,255,0)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With selectedRng.Interior
If Cells.Value > Upper_limit Or cell.Value < Lower_limit Then
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65280 'Same as RGB(255,0,0)
.TintAndShade = 0
.PatternTintAndShade = 0
End If
End With
'Stop before running error handling.
Exit Sub
errHandler:
'Quit sub procedure when user clicks InputBox Cancel button.
If Err.Number = 424 Then
Exit Sub
Else: MsgBox "Error: " & Err.Number, vbOK
End If
End Sub
uj5u.com熱心網友回復：
您需要遍歷并測驗每個單元格，而不是整個selectedRng范圍。插入此代碼......在您測驗值的地方，您應該會很好。
Dim aCell As Range
For Each aCell In selectedRng.Cells
With aCell
If .Value > Upper_limit Or .Value < Lower_limit Then
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65280 'Same as RGB(255,0,0)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End With
Next aCell
所以你的最終輸出將是這個......
Sub Data_Prep()
'Identify Outliers
'Specify Dims.....
Dim ws_instruction As Worksheet
Dim ws_data As Worksheet
Dim ws_output As Worksheet
Dim selectedRng As Range
Dim record_cell As Variant
Dim Upper_limit As Variant
Dim Lower_limit As Variant
Dim AnswerYes As String
Dim AnswerNo As String
'Ascribe worksheets
Set ws_instruction = ThisWorkbook.Worksheets("Instruction Sheet")
Set ws_data = ThisWorkbook.Worksheets("Data Sheet")
Set ws_output = ThisWorkbook.Worksheets("Output Sheet")
Set selectedRng = Application.Selection
'Error handling to capture Cancel key.
On Error GoTo errHandler
'Define range.
Set selectedRng = Application.InputBox("Range", , selectedRng.Address, Type:=8)
record_cell = selectedRng.Address(ReferenceStyle:=xlA1, _
RowAbsolute:=False, ColumnAbsolute:=False)
Cells(1, 9).Value = record_cell
Cells(1, 10).Value = record_cell
'Format Output Information
ws_output.Cells(4, 1).Value = "Upper Limit"
ws_output.Cells(5, 1).Value = "Lower Limit"
'Limits for the Selected Array
Upper_limit = 52
Lower_limit = 13
ws_output.Cells(4, 2).Value = Upper_limit
ws_output.Cells(5, 2).Value = Lower_limit
On Error GoTo errHandler
'Do something to the selected or input range.
With selectedRng.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535 'Same as RGB(255,255,0)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Dim aCell As Range
For Each aCell In selectedRng.Cells
With aCell
If .Value > Upper_limit Or .Value < Lower_limit Then
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65280 'Same as RGB(255,0,0)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End With
Next aCell
'Stop before running error handling.
Exit Sub
errHandler:
'Quit sub procedure when user clicks InputBox Cancel button.
If Err.Number = 424 Then
Exit Sub
Else: MsgBox "Error: " & Err.Number, vbOK
End If
End Sub
清潔方法
此外，如果您只是想要一種更簡潔的方式來做這樣的事情，請考慮這種型別的代碼......
Sub highlightstuff()
Const yesColor As Long = 65280
Const noColor As Long = 65535
Const Lower_limit As Long = 13
Const Upper_limit As Long = 52
Dim yesRange As Range, noRange As Range, allRange As Range, aCell As Range
Set allRange = Selection '<--- probably not a good ide
For Each aCell In allRange.Cells
If IsNumeric(aCell) Then ' maybe you don't need this...
If aCell.Value > Upper_limit Or aCell.Value < Lower_limit Then
If yesRange Is Nothing Then
Set yesRange = aCell
Else
Set yesRange = Union(aCell, yesRange)
End If
Else
If noRange Is Nothing Then
Set noRange = aCell
Else
Set noRange = Union(aCell, noRange)
End If
End If
End If
Next aCell
yesRange.Interior.Color = yesColor
noRange.Interior.Pattern = noColor
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/372744.html