为工作表函数填充单元格颜色（基于选择的案例和范围）

下面是我创建的尝试显示颜色范围的工作表（Dragdown）函数的工作表设置。我的问题是如何执行一个函数，其中我的工作表单元格颜色会根据与我当前的Work_Sheet更改/设置性能事件关联的（Select Case Statement）进行更改。为工作表函数填充单元格颜色（基于选择的案例和范围）

当前的代码我有下面只产生用于所有小区

Peromance_Message（工作片功能设置具有可变参数）

非优选的平均名称（$ d $ 43 - 文本字符串）一种颜色列头
非优选平均（D43-单人间）下面的数据（数据开始）
优选平均名称（E $ 42-文本字符串）的列标题
优选平均（E43-单人间）下面的数据（数据开始）
列到d &电子商务右（I下拉式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

WORKSHEET

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

来源

2016-04-21 Brian Sullivan

看到这个[答案]（ http://stackoverflow.com/questions/13705663/e Xcel公司用户自定义函数 - 变化 - 的细胞色）。你所要求的是无法完成的，因为UDF不允许更改工作表或其他单元格。 - 可以用Sub来完成。条件格式非常强大，请考虑使用它。 – OldUgly

您需要在函数中指定cellcolor值。 –

请尝试下面

查阅标志着COMMENT

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

WORKSHEET

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

证明的变化：

编辑从这里

根据您的问题，下面是代码的答案

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

WORKSHEET

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

来源

2016-04-21 06:36:22

非常感谢您提供关于此（选择案例）填充问题的不同观点。我将函数输出合成到VBE编辑器代码的初始思考过程分散在大自然中。这种特定的解决方案将代码连接到工作表上的物理范围。我认为自己是VBA的初级初学者初学者，但我很高兴自己已经接近终点。 –

如果您满意我的代码，请将其标记为解决方案。 –

问题1-为什么当我拖动工作表函数公式时，从参数OutputType中删除可选/变量时，出现调试不匹配错误？（注意：颜色参数是我的工作表函数公式的一部分，与我的公式匹配） –

为工作表函数填充单元格颜色（基于选择的案例和范围）

回答

相关问题