循环遍历重复代码

Question

我正在使用一个电子表格，它将实时价格从tdameritrade引入到一个单元格中，这个公式为=RTD("tos.rtd"，"LAST"，B4)。假设公式的起始价格是30.00美元。如果下一个价格，公式带来的30.02美元，细胞颜色将变成绿色。如果下一个价格公式降低到30.01美元，细胞颜色就会变红。所以如果它比以前的价格上涨，细胞就会变绿，如果它比以前的价格下降，细胞就会变红。当我试图在单元格、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

您可以使用while和do while 环

下面的循环可能对你有帮助！

​

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

​