Excel 循环优化：将两个循环合并为一个

我在下面写了两个循环：

Dim intLstRowA As Integer
Dim intLstRowB As Integer

intLstRowA = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
intLstRowB = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To intLstRowA
        Sheets(1).Cells(i, 22).Value2 = Sheets(1).Cells(i, 4).Value2 * Sheets(1).Cells(i, 5).Value2
        Sheets(1).Cells(i, 23).Value2 = Sheets(1).Cells(i, 4).Value2 * Sheets(1).Cells(i, 6).Value2
        Sheets(1).Cells(i, 24).Value2 = Sheets(1).Cells(i, 4).Value2 * Sheets(1).Cells(i, 9).Value2
        Sheets(1).Cells(i, 25).Value2 = Sheets(1).Cells(i, 4).Value2 * Sheets(1).Cells(i, 19).Value2
        Sheets(1).Cells(i, 26).Value2 = Sheets(1).Cells(i, 4).Value2 * Sheets(1).Cells(i, 20).Value2
Next i
For i = 2 To intLstRowB
        Sheets(2).Cells(i, 22).Value2 = Sheets(2).Cells(i, 4).Value2 * Sheets(2).Cells(i, 5).Value2
        Sheets(2).Cells(i, 23).Value2 = Sheets(2).Cells(i, 4).Value2 * Sheets(2).Cells(i, 6).Value2
        Sheets(2).Cells(i, 24).Value2 = Sheets(2).Cells(i, 4).Value2 * Sheets(2).Cells(i, 9).Value2
        Sheets(2).Cells(i, 25).Value2 = Sheets(2).Cells(i, 4).Value2 * Sheets(2).Cells(i, 19).Value2
        Sheets(2).Cells(i, 26).Value2 = Sheets(2).Cells(i, 4).Value2 * Sheets(2).Cells(i, 20).Value2
Next i

有两个循环，因为intLstRowA与intLstRowB不同（通常相差20到50），否则我会在图纸（1）和图纸（2）之间的循环中添加一个“j”值（从1到2）

---

有什么想法吗？

如果某段代码被多次使用，最好使用单独的函数/过程，例如：

Sub DoSomething(ByVal wsh As Worksheet)
    Dim intLastRow As Integer

    inLastRow = wsh.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To intLstRowA
            wsh.Cells(i, 22).Value2 = wsh.Cells(i, 4).Value2 * wsh.Cells(i, 5).Value2
            wsh.Cells(i, 23).Value2 = wsh.Cells(i, 4).Value2 * wsh.Cells(i, 6).Value2
            wsh.Cells(i, 24).Value2 = wsh.Cells(i, 4).Value2 * wsh.Cells(i, 9).Value2
            wsh.Cells(i, 25).Value2 = wsh.Cells(i, 4).Value2 * wsh.Cells(i, 19).Value2
            wsh.Cells(i, 26).Value2 = wsh.Cells(i, 4).Value2 * wsh.Cells(i, 20).Value2
    Next i
End Sub

用法：

Dim sh as Worksheet
Dim i as Integer

For i = 1 to 2
    Set sh = ThisWorkbook.Worksheet(i)
    DoSomething sh
Next 

总结：
1.代码被优化（只为…下一个循环编写一个

，而不是两个）

2.代码在上下文中工作（在存储代码的工作簿中进行更改，而不是在活动工作簿中进行更改）

我看不到其他选项可以将代码“优化”为单个
，用于下一个
循环。
您可以使用第二个子项（删除）重复，并使用范围删除循环，即：

Sub Recut()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lngLstRowA As Long
Dim lngLstRowB As Long

Set ws1 = Sheets(1)
Set ws2 = Sheets(2)

lngLstRowA = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lngLstRowB = ws2.Cells(Rows.Count, 1).End(xlUp).Row

Call Update(ws1, lngLstRowA)
Call Update(ws2, lngLstRowB)

End Sub

Sub Update(ws As Worksheet, lngRow As Long)

With ws
    Range(.Cells(2, 22), .Cells(lngRow, 22)).FormulaR1C1 = "=RC4*RC5"
    Range(.Cells(2, 23), .Cells(lngRow, 23)).FormulaR1C1 = "=RC4*RC6"
    Range(.Cells(2, 24), .Cells(lngRow, 24)).FormulaR1C1 = "=RC4*RC9"
    Range(.Cells(2, 25), .Cells(lngRow, 25)).FormulaR1C1 = "=RC4*RC19"
    Range(.Cells(2, 26), .Cells(lngRow, 26)).FormulaR1C1 = "=RC4*RC20"
    Range(.Cells(2, 22), .Cells(lngRow, 26)).Value = Range(.Cells(2, 22), .Cells(lngRow, 26)).Value
End With

End Sub

这差不多是我能拿到的最紧的了

Dim i As Long, v As Long, s As Long, vCOLs As Variant

vCOLs = Array(Array(22, 23, 24, 25, 26), Array(5, 6, 9, 19, 20))

For s = 1 To 2
    With Sheets(s)
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            For v = LBound(vCOLs(1)) To UBound(vCOLs(1))
                .Cells(i, vCOLs(0)(v)) = .Cells(i, 4).Value2 * .Cells(i, vCOLs(1)(v)).Value2
            Next v
        Next i
    End With
Next s

这是通过将二维数组的两个秩用于为计算的源和目标提供列索引号来实现的

将编译但不针对样本数据进行现场测试。
您始终可以将
intLstRow
放入数组，并使用
j
对其进行迭代（即
intLstRow
将是
intLstRow[0]
），谢谢大家！你的答案都很好，但是Jeeped的那一个截取了我要找的东西。我正要发布没有循环的相同方法：）确实按照请求大大缩短了代码-虽然这是保留范围循环的代价。@brettdj-同意使用公式块并转换为它们的值会更有效。我希望看到一些计时结果，但我不愿意创建50000行左右的示例数据。它返回的运行时错误9下标超出范围：（知道为什么吗？我只有2000行。返回错误的行是哪一行？当然你有两个工作表，每个工作表都有26列以上。是的，我有两个工作表，超过26列：）行是：单元格（I，vCOLs（v，1））=.Cells（I，4）。Value2*.Cells（I，vCOLs（v，2））。Value2