Board logo

標題: [發問] 當資料輸入完成後,自動變紅字 [打印本頁]

作者: cyfchuang    時間: 昨天 16:25     標題: 當資料輸入完成後,自動變紅字

請益各位
當前的工作表
A2到C4的數字【實測值】,低於D2或高於E2【規格】,當A2到C4的數字資料輸入完成後,實測值超規的自動變紅字
A7到C7的數字【實測值】,低於D7或高於E7【規格】,當A7到C7的數字資料輸入完成後,實測值超規的自動變紅字
A9到C9的數字【實測值】,低於D9或高於E9【規格】,當A9到C9的數字資料輸入完成後,實測值超規的自動變紅字
如何使用 VBA 來完成超規的數值變成紅字

[attach]38082[/attach][attach]38083[/attach][attach]38084[/attach]
作者: hcm19522    時間: 2 小時前

(搜尋 輸入號碼 14317) google網址:https://hcm19522.blogspot.com/
作者: cyfchuang    時間: 1 小時前

找到答案了,謝謝各位幫忙

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




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)