Andy2483

回復 10# 軒云熊


    謝謝前輩再提供情境範例
後學猜測情境是:
輸入前:

下載 (72.67 KB)

2022-11-23 10:05

各個儲存格輸入後:

下載 (84.2 KB)

2022-11-23 10:06

後學建議觸發方式,請各位前輩指導!謝謝

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim A&, Ti#, Ts$
With Target
   If (.Row >= 7 And .Row <= 17 And .Row Mod 3 = 1) And (.Column >= 7 And .Column <= 16) And .Count = 1 Then
      A = .Value
      If (A < 48 Or A > 50) And (A <> 0 Or .Value <> "") Then
         .Interior.Color = RGB(255, 255, 0)
         Ti = (50 - A) / 1000
         Ts = Format(Ti, "0.000")
         .Offset(1, 0) = IIf(Ti > 0, "+" & Ts, Ts)
         .Offset(1, 0).Interior.Color = RGB(170, 240, 190)
         Else
            .Interior.ColorIndex = xlNone
            .Offset(1, 0).Interior.ColorIndex = xlNone
            .Offset(1, 0) = ""
      End If
   End If
End With
Application.EnableEvents = True
End Sub

Andy2483

回復 10# 軒云熊


    謝謝前輩
後學藉此範例練習 自訂義函數,觀念不知是否對?? 懇請各位前輩指導!謝謝

[G8]儲存格輸入 =GetRangeStep(48,50,G7)  :

下載 (128.86 KB)

2022-11-23 16:42

[G7]...輸入數字結果:

下載 (88.91 KB)

2022-11-23 16:44

Option Explicit
Function GetRangeStep(Mi As Long, Mx As Long, xArea As Range)
'自訂義函數 GetRangeStep(最小值,最大值,計算的儲存格)
'[G8]儲存格輸入 =GetRangeStep(48,50,G7)
'[G8]儲存格複製公式到其他儲存格
Dim xR As Range, xV$, Ti#, Ts$
Application.Volatile
If (xArea.Value < Mi Or xArea.Value > Mx) And xArea.Value <> "" Then
   Ti = (50 - xArea) / 1000
   Ts = Format(Ti, "0.000")
   xV = IIf(Ti > 0, "+" & Ts, Ts)
   Else
      xV = ""
End If
GetRangeStep = xV
End Function

劉大胃

Hello, 軒云熊 大

頁面::[01]
(1) 中心值為50  --> F5=50
(2) 加減值公式 --> G8= IF(G7="","",IF($F$5>=G7,"+","") & Text(($F$5-G7)*0.001,"0.000"))

頁面::[02]
(1) 中心值為10  --> B1=10
(2) 加減值公式 --> C5=IF(OR(C4="",$B$1=C4),"",IF($B$1>=C4,"+","") & TEXT(($B$1-C4)*0.001,"0.000"))

以上, 裡面的顏色, 可以用"設定格式化的條件" 功能去定義. 所以只要保留清除功能鍵, 而功能鍵裡也只要做點位及實際值的內容值清除即可.

Thanks ~

軒云熊

感謝 劉大胃  和 Andy2483  大大的幫忙   這樣好多了 謝謝