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

最简单的方法可能是使用offset和一个计数器，该计数器在循环的每次迭代中都增加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”是静态的。由于您的范围是一个简单的范围，因此您可以使用每个循环的行号（带-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

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

3 个答案: