vba Excel 用户定义函数:更改单元格的颜色

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/13705663/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 14:31:44  来源:igfitidea点击:

Excel User Defined Function: change the cell's color

excelvba

提问by Larry K

I have a user defined function in Excel. It is called as a formula function from spreadsheet cells and works fine.

我在 Excel 中有一个用户定义的函数。它被称为电子表格单元格中的公式函数并且工作正常。

I'd like the function to be able to change the cell's color depending on the value that it returns. Essentially, changing the cell's color is a side effect of the function.

我希望该函数能够根据它返回的值更改单元格的颜色。本质上,更改单元格的颜色是该函数的副作用。

I tried

我试过

Application.ThisCell.Interior.ColorIndex = 2

But it fails.

但它失败了。

回答by JonoMac

Here's a demonstration of how a VBA UDF can change the colouring of a sheets contents rather than using conditional formatting.

这里演示了 VBA UDF 如何更改工作表内容的颜色,而不是使用条件格式。

As long as both sheets have rows and columns sorted in the same order then this will compare for differences in every cell between two seperate Excel sheets.

只要两个工作表的行和列都以相同的顺序排序,那么这将比较两个单独的 Excel 工作表之间每个单元格的差异。

You can add this into as many cells as you need to on a third sheet to detect differences between the same two cells on the two sheets with data on: =DifferenceTest(Sheet1!A1,Sheet2!A1)

您可以将其添加到第三张工作表上所需的任意数量的单元格中,以检测两张工作表上相同的两个单元格之间的差异,其中数据位于: =DifferenceTest(Sheet1!A1,Sheet2!A1)

And the function to be stored in the VBA editor as follows:

以及要存储在 VBA 编辑器中的函数如下:

Function DifferenceTest(str1 As String, str2 As String) As String

    If str1 = str2 Then
            Application.Caller.Font.ColorIndex = 2
    Else
            Application.Caller.Font.ColorIndex = 3
            DifferenceTest = str1 & " vs " & str2
    End If

End Function

回答by shahkalpesh

This cannot be done. User defined functions cannot change the state of the workbook/worksheet etc.

这是无法做到的。用户定义的函数不能改变工作簿/工作表等的状态。

Use Conditional Formatting to achieve what you are trying.

使用条件格式来实现您的尝试。

EDIT: This is more of a suggestion, not a real answer.

编辑:这更像是一个建议,而不是一个真正的答案。

回答by aevanko

No, you cannot alter a cell's color using a Function(). You can, however, alter it in a Sub()routine.

不,您不能使用Function()更改单元格的颜色。但是,您可以在Sub()例程中更改它。

Simply write a Sub() that will run your function on the cells you wish it to be run on, then after each is run, put an If-statement to see if you want to color it based on the value it returns.

只需编写一个 Sub() ,它将在您希望运行的单元格上运行您的函数,然后在每次运行后,放置一个 If 语句以查看是否要根据它返回的值对其进行着色。

回答by Diederik

You could create a vba code that runs automatically after there is a change in your sheet. Instead of hving the code in a seperate module you have to embed it in the sheet itself.

您可以创建一个在工作表发生更改后自动运行的 vba 代码。您必须将代码嵌入到工作表本身中,而不是将代码放在单独的模块中。

Right click on the sheet tab, choose View Code, and create the following code:

右键单击工作表选项卡,选择查看代码,然后创建以下代码:

Private Sub Worksheet_Change(ByVal Target As Range)

For Each cell In Range("A1:B8") 'change cell range as needed

Select Case cell.Value
Case 8
cell.Interior.ColorIndex = 4 'cell color becomes green when cell value is 8
Case ""
cell.Interior.ColorIndex = 1 'cell color becomes black when cell is empty
Case Is < 6
cell.Interior.ColorIndex = 7 'cell color becomes pink when cell value is smaller than 6
Case Else
cell.Interior.ColorIndex = 0 'all other cells get no color
End Select

Next cell

End Sub

回答by ?inh Qu?c Tu?n

Function HexToLongRGB(sHexVal As String) As Long
    Dim lRed As Long
    Dim lGreen As Long
    Dim lBlue As Long
    lRed = CLng("&H" & Left$(sHexVal, 2))
    lGreen = CLng("&H" & Mid$(sHexVal, 3, 2))
    lBlue = CLng("&H" & Right$(sHexVal, 2))
    HexToLongRGB = RGB(lRed, lGreen, lBlue)
End Function

Function setBgColor(ByVal stringHex As String)
    Evaluate "setColor(" & Application.Caller.Offset(0, 0).Address(False, False) & ",""" & stringHex & """)"
    setBgColor = ""
End Function


Sub setColor(vCell As Range, vHex As String)
    vCell.Interior.Color = HexToLongRGB(vHex)
End Sub

回答by adoxa

I tried the Evaluatemethod, which worked but immediately crashed (2007). The help mentions caching the address, so that's my approach - store the cell and color in a collection, then change the color after the calculation.

我尝试了该Evaluate方法,该方法有效但立即崩溃(2007)。帮助中提到了缓存地址,所以这就是我的方法 - 将单元格和颜色存储在一个集合中,然后在计算后更改颜色。

Dim colorCells As New Collection

Function UDF...
    UDF = <whatever>
    color = <color for whatever>
    colorCells.Add (Application.Caller)
    colorCells.Add (color)
End Function

Sub SetColor()
    While colorCells.Count <> 0
        colorCells(1).Interior.Color = colorCells(2)
        colorCells.Remove (1)
        colorCells.Remove (1)
    Wend
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    SetColor
End Sub