- 帖子
- 8
- 主題
- 4
- 精華
- 0
- 積分
- 62
- 點名
- 0
- 作業系統
- WIN10
- 軟體版本
- OFFICE2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2016-12-8
- 最後登錄
- 2025-9-9
|
找到答案了，謝謝各位幫忙
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cell As Range
Dim lowerLimit1 As Double, upperLimit1 As Double
Dim lowerLimit2 As Double, upperLimit2 As Double
Dim lowerLimit3 As Double, upperLimit3 As Double
Dim lowerLimit4 As Double, upperLimit4 As Double
' 設定當前工作表
Set ws = ThisWorkbook.ActiveSheet
' 讀取條件範圍的值
lowerLimit1 = ws.Range("T14").Value
upperLimit1 = ws.Range("U14").Value
lowerLimit2 = ws.Range("T15").Value
upperLimit2 = ws.Range("U15").Value
lowerLimit3 = ws.Range("T19").Value
upperLimit3 = ws.Range("U19").Value
lowerLimit4 = ws.Range("T20").Value
upperLimit4 = ws.Range("U20").Value
' 檢查範圍
For Each cell In ws.Range("K14:R14")
If IsNumeric(cell.Value) Then
If cell.Value < lowerLimit1 Or cell.Value > upperLimit1 Then
cell.Font.Color = RGB(255, 0, 0) ' 設為紅色
Else
cell.Font.Color = RGB(0, 0, 0) ' 恢復為黑色
End If
End If
Next cell
' 檢查範圍
For Each cell In ws.Range("K15:R18")
If IsNumeric(cell.Value) Then
If cell.Value < lowerLimit2 Or cell.Value > upperLimit2 Then
cell.Font.Color = RGB(255, 0, 0) ' 設為紅色
Else
cell.Font.Color = RGB(0, 0, 0) ' 恢復為黑色
End If
End If
Next cell
' 檢查範圍
For Each cell In ws.Range("K19:R19")
If IsNumeric(cell.Value) Then
If cell.Value > upperLimit3 Then
cell.Font.Color = RGB(255, 0, 0) ' 設為紅色
Else
cell.Font.Color = RGB(0, 0, 0) ' 恢復為黑色
End If
End If
Next cell
' 檢查範圍
For Each cell In ws.Range("K20:R22")
If IsNumeric(cell.Value) Then
If cell.Value < lowerLimit4 Or cell.Value > upperLimit4 Then
cell.Font.Color = RGB(255, 0, 0) ' 設為紅色
Else
cell.Font.Color = RGB(0, 0, 0) ' 恢復為黑色
End If
End If
Next cell
End Sub |
|
發表於 
