填写工作表function的单元格颜色(基于select的案例和范围)

下面是我创build的工作表(Dragdown)函数的工作表设置,试图显示一个颜色范围。 我的问题是如何执行一个函数,我的工作表单元格颜色更改基于(Select Case Statement)与我当前的Work_Sheet更改/设置性能事件绑定。

我下面的当前代码只为所有单元格生成一种颜色

Peromance_Message(具有可变参数的工作表function设置)

非首选平均名称($ D $ 42 – 文本string)列标题
下面的非首选平均(D43-单一)数据(数据开始)
首选平均名称(E $ 42-文本string)列标题
首选的平均(E43-单一)数据(数据开始)
D&E右边的列(我下拉Performance_Message公式)

MODULE

Public Function Performance_Message(NonPreferredAvg As Single _ , NonPreferredAvgname As String _ , PreferredAvg As Single _ , PreferredAvgname As String _ , Optional Outputtype As String _ ) As Variant Dim performancemessage As String Dim averagedifference As Single Dim stravgdif As String Dim cellcolor As String averagedifference = Abs(NonPreferredAvg - PreferredAvg) stravgdif = FormatPercent(averagedifference, 2) Select Case PreferredAvg Case Is < NonPreferredAvg performancemessage = PreferredAvgname & " Is " & stravgdif & " Less Than " & NonPreferredAvgname cellcolor = "green" Case Is = NonPreferredAvg performancemessage = PreferredAvgname & " Equals " & NonPreferredAvgname cellcolor = "yellow" Case Is > NonPreferredAvg performancemessage = PreferredAvgname & " Is " & stravgdif & " Greater Than " & NonPreferredAvgname cellcolor = "blue" Case Else performancemessage = "Something Bad Happened" End Select If Outputtype = "color" Then Performance_Message = cellcolor Else Performance_Message = performancemessage End If End Function 

工作表

 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Double myColor = 135 Call SetPerformancecolor(Target, myColor) End Sub Private Sub SetPerformancecolor(Target As Range, myColor As Double) Target.Interior.Color = myColor End Sub 

请尝试下面

查看评论中标记的变化

MODULE

 Public Function Performance_Message(NonPreferredAvg As Single _ , NonPreferredAvgname As String _ , PreferredAvg As Single _ , PreferredAvgname As String _ , Optional Outputtype As String _ ) As Variant Dim performancemessage As String Dim averagedifference As Single Dim stravgdif As String Dim cellcolor As String averagedifference = Abs(NonPreferredAvg - PreferredAvg) stravgdif = FormatPercent(averagedifference, 2) Select Case PreferredAvg Case Is < NonPreferredAvg performancemessage = PreferredAvgname & " Is " & stravgdif & " Less Than " & NonPreferredAvgname cellcolor = 4 ' changes made "green" Case Is = NonPreferredAvg performancemessage = PreferredAvgname & " Equals " & NonPreferredAvgname cellcolor = 6 ' changes made "yellow" Case Is > NonPreferredAvg performancemessage = PreferredAvgname & " Is " & stravgdif & " Greater Than " & NonPreferredAvgname cellcolor = 5 ' changes made "blue" Case Else performancemessage = "Something Bad Happened" End Select If Outputtype = "color" Then Performance_Message = cellcolor Else Performance_Message = performancemessage End If End Function 

工作表

 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("F:F")) Is Nothing Then ' changes made Dim myColor As Double myColor = Target.Value ' changes made Call SetPerformancecolor(Target, myColor) End If End Sub Private Sub SetPerformancecolor(Target As Range, myColor As Double) Target.Interior.ColorIndex = myColor ' changes made End Sub 

certificate:

在这里输入图像说明

编辑从这里

根据你的问题,下面是代码的答案

MODULE

 Public Function Performance_Message(NonPreferredAvg As Single _ , NonPreferredAvgname As String _ , PreferredAvg As Single _ , PreferredAvgname As String _ , Optional Outputtype As String _ ) As Variant Dim performancemessage As String Dim averagedifference As Single Dim stravgdif As String Dim cellcolor As String averagedifference = Abs(NonPreferredAvg - PreferredAvg) stravgdif = FormatPercent(averagedifference, 2) Select Case PreferredAvg Case Is < NonPreferredAvg performancemessage = PreferredAvgname & " Is " & stravgdif & " Less Than " & NonPreferredAvgname cellcolor = 4 Case Is = NonPreferredAvg performancemessage = PreferredAvgname & " Equals " & NonPreferredAvgname cellcolor = 6 Case Is > NonPreferredAvg performancemessage = PreferredAvgname & " Is " & stravgdif & " Greater Than " & NonPreferredAvgname cellcolor = 5 Case Else performancemessage = "Something Bad Happened" End Select If IsMissing(Outputtype) Then Performance_Message = cellcolor Else Performance_Message = performancemessage End If End Function 

工作表

 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("F:F")) Is Nothing Then Dim myColor As Double If IsNumeric(Target.Value) = True Then myColor = Target.Value Call SetPerformancecolor(Target, myColor) Else Call SetPerformancecolor(Target, 0) End If End If End Sub Private Sub SetPerformancecolor(Target As Range, myColor As Double) Target.Interior.ColorIndex = myColor End Sub