Question

我正在使用一个电子表格，将来自tdameritrade的实时价格带入具有此公式的单元格= RTD（“tos.rtd”，“LAST”，B4）。假设公式带来的起始价格是30.00美元。如果公式带来的下一个价格高达30.02美元，则单元格颜色将变为绿色。如果公式带来的下一个价格降至30.01美元，则单元格颜色将变为红色。因此，如果它从之前的价格上涨，则单元格将变为绿色，如果它从之前的价格下降，则单元格将变为红色。当我试图在Cell，B4，B5，B6，B7中添加更多结果时，我复制了代码并且它正在工作，但是按照我想要的数千个结果继续添加代码是不切实际的。任何人都知道如何更改代码以循环通过它，因为我自己不够先进，但很想学习如何。

由于

工作表代码

 Private Sub Worksheet_Calculate()
      Call updateme
    End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
      Call updateme
    End Sub


    Private Sub updateme()
      Set cell = ActiveSheet.Range("B4")
      newval = cell.Value
      If newval < lastval Then
        cell.Interior.ColorIndex = 3
      End If
      If newval > lastval Then
        cell.Interior.ColorIndex = 4
      End If
      Set cell2 = ActiveSheet.Range("B5")
      newval2 = cell2.Value
       If newval2 < lastval2 Then
        cell2.Interior.ColorIndex = 3
      End If
      If newval2 > lastval2 Then
        cell2.Interior.ColorIndex = 4
      End If
        Set cell3 = ActiveSheet.Range("B6")
      newval3 = cell3.Value
       If newval3 < lastval3 Then
        cell3.Interior.ColorIndex = 3
      End If
      If newval3 > lastval3 Then
        cell3.Interior.ColorIndex = 4
      End If
          Set cell4 = ActiveSheet.Range("B7")
      newval4 = cell4.Value
       If newval4 < lastval4 Then
        cell4.Interior.ColorIndex = 3
      End If
      If newval4 > lastval4 Then
        cell4.Interior.ColorIndex = 4
      End If
     lastval = newval
     lastval2 = newval2
     lastval3 = newval3
     lastval4 = newval4
    End Sub

**Module Code**

Public lastval As Double
Public lastval2 As Double
Public lastval3 As Double
Public lastval4 As Double

Answer 1

您可以使用For while并执行loops

下面的循环可能会帮助你......！

＆＃13;

Private Sub updateme()

Dim cell As Range
' change the start and end range of i as required
For i = 4 To 7
    ' change the column here as required
      Set cell = ActiveSheet.Range("B" & i)
      newval = cell.Value
    
      If newval < lastval Then
        cell.Interior.ColorIndex = 3
      End If
      If newval > lastval Then
        cell.Interior.ColorIndex = 4
      End If
      
     lastval = newval
Next

End Sub

＆＃13;

循环重复代码

1 个答案: