Excel : Alternatively Change Cell Color as Cell Va

2019-08-31 16:45发布

I have developed an Excel Real-Time Data Feed (RTD) to monitor Stock Prices as they arrive.
I Would like to find a way to change the color of a cell as prices change.

For example, a cell initially Green would turn to Red when the value changes (new price occurred on it via RTD Formula it contains) and then change back to Green when a new price arrives, and so on...

6条回答
Lonely孤独者°
2楼-- · 2019-08-31 17:16

I was looking for same. My scenario was like change the color of cell when value is select from list. Each list item corresponds for a color.

What eventually worked for me is:

Private Sub Worksheet_Change(ByVal Target As Range)

    Set MyPlage = Range("B2:M50")

    For Each Cell In MyPlage

        Select Case Cell.Value

         Case Is = "Applicable-Incorporated"

            Cell.Font.Color = RGB(0, 128, 0)
        Case Is = "Applicable/Not Incorporated"
            Cell.Font.Color = RGB(255, 204, 0)

        Case Is = "Not Applicable"
            Cell.Font.Color = RGB(0, 128, 0)

        Case Else
            Cell.EntireRow.Interior.ColorIndex = xlNone

        End Select

    Next

    ActiveWorkbook.Save

End Sub
查看更多
Bombasti
3楼-- · 2019-08-31 17:18

Maybe this can get you started? I supose a event is raised when the real time data is refreshed. the concept sis to store the real time data in a variabele and check if it has changed

 Dim rtd As String

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With ActiveSheet.Range("A1")
        If .Value <> rtd Then
            Select Case .Interior.ColorIndex
                Case 2
                    .Interior.ColorIndex = 3
                Case 3
                    .Interior.ColorIndex = 4
                Case 4
                    .Interior.ColorIndex = 3
                Case Else
                    .Interior.ColorIndex = 2
            End Select
        Else
            .Interior.ColorIndex = 2

        End If
        rtd = .Value
    End With

End Sub
查看更多
Juvenile、少年°
4楼-- · 2019-08-31 17:21

This solution reposonds to a Calculation event. I am not entirely sure if an RTD update triggers this, so you will need to experiment.

Add this code to the Worksheet module containing your RTD calls.

It keeps a copy of the sheet data in memory from the last calculation, and on each calc compares new values.
It limits its action to cells containing your formula.

Option Explicit

Dim vData As Variant
Dim vForm As Variant

Private Sub Worksheet_Calculate()
    Dim vNewData As Variant
    Dim vNewForm As Variant
    Dim i As Long, j As Long

    If IsArray(vData) Then
        vNewData = Me.UsedRange
        vNewForm = Me.UsedRange.Formula
        For i = LBound(vData, 1) To UBound(vData, 1)
        For j = LBound(vData, 2) To UBound(vData, 2)
            ' Change this to match your RTD function name
            If vForm(i, j) Like "=YourRTDFunction(*" Then  
                If vData(i, j) <> vNewData(i, j) Then
                    With Me.Cells(i, j).Interior
                        If .ColorIndex = 3 Then
                            .ColorIndex = 4
                        Else
                            .ColorIndex = 3
                        End If
                    End With
                End If
            End If
        Next j, i
    End If
    vData = Me.UsedRange
    vForm = Me.UsedRange.Formula

End Sub
查看更多
兄弟一词,经得起流年.
5楼-- · 2019-08-31 17:21

Alternatively, the most simple is this code :

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Interior.ColorIndex = 6 ': yellow
End Sub
查看更多
倾城 Initia
6楼-- · 2019-08-31 17:25

Both the previous answer assume that Real-time data feed triggers worksheet events. I can find nothing in the RTD documents to confirm or deny this assumption. However, if it does trigger worksheet events, I would have thought that Worksheet_Change would have been the most useful since it identifies a cell that has changed.

The following might be worth trying. It must be placed in the code area for the relevant worksheet.

Option Explicit
Sub Worksheet_Change(ByVal ChangedCell As Range)

  ' This routine is called whenever the user changes a cell.
  ' It is not called if a cell is changed by Calculate.

  Dim ColChanged As Integer
  Dim RowChanged As Integer

  ColChanged = ChangedCell.Column
  RowChanged = ChangedCell.Row

  With ActiveSheet  
    If .Cells(RowChanged, ColChanged).Font.Color = RGB(255, 0, 0) then 
      ' Changed cell is red.  Set it to green.
      .Cells(RowChanged, ColChanged).Font.Color = RGB(0, 255, 0)
    Else
      ' Changed cell is not red.  Set it to red.
      .Cells(RowChanged, ColChanged).Font.Color = RGB(255, 0, 0)
    End If
  End With

End Sub
查看更多
该账号已被封号
7楼-- · 2019-08-31 17:37
Sub Worksheet_Change(ByVal ChangedCell As Range)

  ' This routine is called whenever the user changes a cell.
  ' It is not called if a cell is changed by Calculate.

  Dim ColChanged As Integer
  Dim RowChanged As Integer

  ColChanged = ChangedCell.Column
  RowChanged = ChangedCell.Row

  With ActiveSheet
    If .Cells(RowChanged, ColChanged).Interior.ColorIndex = 19 Then
      ' Changed cell is red.  Set it to green.
      .Cells(RowChanged, ColChanged).Interior.ColorIndex = 19
    Else
      ' Changed cell is not red.  Set it to red.
      .Cells(RowChanged, ColChanged).Interior.ColorIndex = 19
    End If
  End With

End Sub
查看更多
登录 后发表回答