Question

我有一个运行4个公式的宏。

Sub Kit()
Dim ws As Worksheet
Dim LastRow As Long
Dim i, n, x As Integer
Set ws = ActiveWorkbook.Sheets("Report KIT (2)")
ws.Select
LastRow = Sheets("Report KIT (2)").Range("A" & Sheets("Report KIT (2)").Rows.Count).End(xlUp).Row

For i = 3 To LastRow
On Error Resume Next
If Range("BR" & i) >= Range("AM" & i) Then
Range("BS" & i) = "C"
Else: Range("BS" & i) = "GA + C"
End If
Next i

For i = 3 To LastRow
On Error Resume Next
 Range("BT" & i).Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]=""C"",(RC[-3]/SUMIFS(C[-3],C[-6],RC[-6]))*(VLOOKUP('Report KIT (2)'!RC[-6],GA_C!C[-71]:C[-68],4,0)),SUM((RC[-3]/SUMIFS(C[-3],C[-6],RC[-6]))*(VLOOKUP('Report KIT (2)'!RC[-6],GA_C!C[-71]:C[-68],4,0)),(RC[-3]/SUMIFS(C[-3],C[-6],RC[-6],C[-1],""GA + C""))*(VLOOKUP('Report KIT (2)'!RC[-6],GA_C!C[-71]:C[-69],3,0))))"
    Next i

For i = 3 To LastRow
On Error Resume Next
Range("BU" & i).Select
    ActiveCell.FormulaR1C1 = "=RC[-4]+RC[-1]"
Next i

For i = 3 To LastRow
On Error Resume Next
Range("BV" & i).Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]+RC[-5])*0.13"
Next i


End Sub

我想修改它以重复相同的计算，但是在所有4个公式的每个完整圆圈之后移动起始列：BS; BT; BU; 4个单元格中的BV向前（因此在下一个圆圈上它们变为BW; BX; BY; BZ，然后在第3个运行CA; CB; CC; CD等）并且我想循环它11次。有人可以帮忙吗？

Answer 1

您需要2个新循环并将范围方法更改为单元格方法

For mainLoop = 1 To 11
    For newLoop = 0 To 4
        'demonstration of the change
        'in EDIT added the (newLoop * 4) * mainLoop  into the column increment
        For i = 3 To LastRow
            If Cells(i, 70 + (newLoop * 4) * mainLoop ) >= Cells(i, 39) Then 'change the right part of compare >= as needed
            Cells(i, 71 + (newLoop * 4) * mainLoop ) = "C"
            Else: Cells(i, 71 + (newLoop * 4)*mainLoop ) = "GA + C"
            End If
        Next i

        'repeat similar change in all other loops
        For i = 3 To LastRow
        '...
        Next i

        For i = 3 To LastRow
        '...
        Next i

        For i = 3 To LastRow
        '...
        Next i
    Next newLoop
Next mainLoop

编辑2

在问题的作者正确评论之后......这应该可以解决问题。

    For mainLoop = 0 To 10
    For newLoop = 0 To 3 'changed to 3
        For i = 3 To LastRow
            If Cells(i, 70 + newLoop * 4 + 16 * mainLoop) >= Cells(i, 39) Then 'change the right part of compare >= as needed
            Cells(i, 71 + newLoop * 4 + 16 * mainLoop) = "C"
            Else: Cells(i, 71 + newLoop * 4 + 16 * mainLoop) = "GA + C"
            End If
        Next i

        'repeat similar change in all other loops
        For i = 3 To LastRow
        '...
        Next i
        '...

    Next newLoop
Next mainLoop

Answer 2

您可以尝试以下方法。我使用cells属性引用了带数字的列。在每个公式循环之后，该列递增1。

另请注意，如果您声明此Dim i, n, x As Integer之类的变量，则只会将x声明为整数，i和n将声明为变体。

Option Explicit
Sub Kit()

    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Integer, n As Integer, x As Integer, j As Integer, mcol As Integer
    Set ws = ActiveWorkbook.Sheets("Report KIT (2)")
    ws.Select
    LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

    mcol = 71
    For j = 1 To 11
        For i = 3 To LastRow
            On Error Resume Next
            If Cells(i, mcol - 1) >= Range("AM" & i) Then
                Cells(i, mcol) = "C"
            Else
                Cells(i, mcol) = "GA + C"
            End If
        Next i
        mcol = mcol + 1

        For i = 3 To LastRow
            On Error Resume Next
            Cells(i, mcol) = "D" ''formula using mcol
        Next i
        mcol = mcol + 1

        For i = 3 To LastRow
            On Error Resume Next
            Cells(i, mcol) = "E" ''formula using mcol
        Next i
        mcol = mcol + 1

        For i = 3 To LastRow
            On Error Resume Next
            Cells(i, mcol) = "F" ''formula using mcol
        Next i
        mcol = mcol + 1
    Next j
End Sub

如何在VBA中编写带有变量起始列的公式？

2 个答案:

编辑2