如何在 VBA Excel 中循环遍历一个范围并更新另一个范围

Question

我有一个宏可以筛选某个范围内的单元格，当单元格或其相邻单元格为红色或绿色时，它会为另一个单元格分配一个值，并且它是另一个工作表中的相邻单元格。我已经走了这么远，第一部分有效，但是第二个“循环”我自己无法弄清楚。换句话说，在下面的代码中，我希望 Range ("C1") 和 Range ("D1") 更新为 Range ("C2") 和 Range ("D2") 等等。

Sub AutoTrack()

   Dim rng As Range

   Dim cell As Range

   Set rng = Workbooks("Test").Worksheets("Track").Range("I2:I10")

   For Each cell In rng
   If cell.DisplayFormat.Interior.Color = RGB(146, 208, 80) Or cell.Offset(0, 
    1).DisplayFormat.Interior.Color = RGB(146, 208, 80) Then

Worksheets("Result").Range("D1") = 
    WorksheetFunction.MRound(Worksheets("Track").Range("J2").Value + 0.125, 
     0.125)
    Worksheets("Result").Range("C1") = 
    WorksheetFunction.MRound(Worksheets("Result").Range("D1") - 0.75, 0.125)

ElseIf 

   Worksheets("Track").Range("J2").DisplayFormat.Interior.Color = RGB(255, 0, 0) 
   Or Worksheets("Track").Range("I2").DisplayFormat.Interior.Color = RGB(255, 0, 
   0) Then
    Worksheets("Result").Range("C1") = WorksheetFunction.MRound(Worksheets("Track").Range("I2") - 0.125, 0.125)
    Worksheets("Result").Range("D1") = 
    WorksheetFunction.MRound(Worksheets("Result").Range("C1") + 0.75, 0.125)
    End If
    Next cell

End Sub

Answer 1

最简单的方法可能是使用偏移量和一个计数器，每次循环迭代都会增加 1。

如果您希望无论是否满足任一条件都增加偏移量，则在 If 之外增加 i。

Sub AutoTrack()

Dim rng As Range
Dim cell As Range
Dim i As Long

Set rng = Workbooks("Test").Worksheets("Track").Range("I2:I10")

For Each cell In rng
    If cell.DisplayFormat.Interior.Color = RGB(146, 208, 80) Or cell.Offset(0, 1).DisplayFormat.Interior.Color = RGB(146, 208, 80) Then
        Worksheets("Result").Range("D1").Offset(i) = WorksheetFunction.MRound(cell.Offset(, 1).Value + 0.125, 0.125)
        Worksheets("Result").Range("C1").Offset(i) = WorksheetFunction.MRound(Worksheets("Result").Range("D1").Offset(i) - 0.75, 0.125)
        i = i + 1
    ElseIf cell.Offset(, 1).DisplayFormat.Interior.Color = RGB(255, 0, 0) Or cell.DisplayFormat.Interior.Color = RGB(255, 0, 0) Then
        Worksheets("Result").Range("C1").Offset(i) = WorksheetFunction.MRound(cell - 0.125, 0.125)
        Worksheets("Result").Range("D1").Offset(i) = WorksheetFunction.MRound(Worksheets("Result").Range("C1").Offset(i) + 0.75, 0.125)
        i = i + 1
    End If
Next cell

End Sub

Answer 2

尝试使用这样的计数器：

Dim rng As Range
Dim cell As Range
Dim i As Integer

i = 2

Set rng = ActiveSheet.Range("A1:A10")

For Each cell In rng

If cell.Value = "A" Then

Worksheets("WS1").Range("B" & i) = "OK"

End If

i = i + 1

Next cell

Answer 3

假设“J2”和“I2”是静态的。由于您的范围是一个简单的范围，您可以使用每个循环的行号 w/-1 来设置目标工作表上的行号。

Sub AutoTrack()
Dim scrws As Worksheet, trgtws As Worksheet, rng As Range, cel As Range

Set scrws = ThisWorkbook.Worksheets("Track")
Set trgtws = ThisWorkbook.Worksheets("Result")

Set rng = scrws.Range("I2:I10")

    For Each cel In rng
        If cel.DisplayFormat.Interior.Color = RGB(146, 208, 80) Or cel.Offset(, 1).DisplayFormat.Interior.Color = RGB(146, 208, 80) Then

            trgtws.Cells(cel.Row - 1, "D") = WorksheetFunction.MRound(scrws.Range("J2").Value + 0.125, 0.125)
            trgtws.Cells(cel.Row - 1, "C") = WorksheetFunction.MRound(trgtws.Cells(cel.Row - 1, "D") - 0.75, 0.125)

        ElseIf scrws.Range("J2").DisplayFormat.Interior.Color = RGB(255, 0, 0) Or scrws.Range("I2").DisplayFormat.Interior.Color = RGB(255, 0, 0) Then

            trgtws.Cells(cel.Row - 1, "C") = WorksheetFunction.MRound(scrws.Range("I2") - 0.125, 0.125)
            trgtws.Cells(cel.Row - 1, "D") = WorksheetFunction.MRound(trgtws.Cells(cel.Row - 1, "C") + 0.75, 0.125)

        End If
    Next cel

End Sub