Excel User Defined Function: change the cell's color

前端 未结 6 807
生来不讨喜
生来不讨喜 2020-12-11 11:10

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

I\'d like the function to be able to change the ce

相关标签:
6条回答
  • 2020-12-11 11:38

    I tried the Evaluate method, 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.

    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
    
    0 讨论(0)
  • 2020-12-11 11:40

    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.

    0 讨论(0)
  • 2020-12-11 11:43
    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
    
    0 讨论(0)
  • 2020-12-11 11:46

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

    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.

    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)

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

    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
    
    0 讨论(0)
  • 2020-12-11 11:49

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

    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.

    0 讨论(0)
  • 2020-12-11 11:51

    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.

    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
    
    0 讨论(0)
提交回复
热议问题