Excel: альтернативно изменить цвет ячейки при изменении значения ячейки - PullRequest
0 голосов
/ 20 декабря 2011

Я разработал поток данных в реальном времени (RTD) для мониторинга цен на акции по мере их поступления.
Я хотел бы найти способ изменить цвет ячейки при изменении цен.

Например, ячейка, изначально зеленая, изменится на красный, когда значение изменится (новая цена произошла с ней по формуле RTD, которую она содержит), а затем изменится на зеленый, когда прибудет новая цена, и так далее ...

Ответы [ 6 ]

3 голосов
/ 20 декабря 2011

Может быть, это поможет вам начать? Я полагаю, что событие происходит при обновлении данных в реальном времени. Идея заключается в том, чтобы хранить данные в реальном времени в переменной и проверять, изменились ли они

 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
1 голос
/ 16 января 2013
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
0 голосов
/ 22 августа 2018

В качестве альтернативы наиболее простым является этот код:

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Interior.ColorIndex = 6 ': yellow
End Sub
0 голосов
/ 22 апреля 2014

Я искал то же самое.Мой сценарий был похож на изменение цвета ячейки, когда значение выбирается из списка.Каждый элемент списка соответствует цвету.

Что в итоге сработало для меня:

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
0 голосов
/ 21 декабря 2011

Оба предыдущих ответа предполагают, что в режиме реального времени подача данных запускает события рабочего листа.Я не могу найти ничего в документах RTD, чтобы подтвердить или опровергнуть это предположение.Тем не менее, если бы он вызывал события рабочего листа, я бы подумал, что Worksheet_Change был бы наиболее полезным, поскольку он идентифицирует измененную ячейку.Он должен быть помещен в область кода для соответствующего рабочего листа.

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
0 голосов
/ 21 декабря 2011

Это решение соответствует событию Calculation. Я не совсем уверен, инициирует ли это обновление RTD, поэтому вам нужно будет поэкспериментировать.

Добавьте этот код в модуль Worksheet, содержащий ваши вызовы RTD.

Сохраняет копию данных листа в памяти из последнего расчета и сравнивает новые значения при каждом расчете.
Он ограничивает свое действие клетками, содержащими вашу формулу.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...