Question

我在下面写了两个循环：

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之间），否则我会添加一个＆＃34; j＆＃34;值（从1到2）在Sheets（1）和Sheets（2）之间循环。

有什么想法吗？

Answer 1

您可以使用第二个子（删除）复制，并使用范围删除循环，即：

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

Answer 2

这和我能得到的一样紧。

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

这可以通过将二维数组的两个等级用于提供计算源和目标的列索引号来实现。

将针对样本数据进行编译但不进行现场测试。

Answer 3

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

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.优化代码（只写一个for... next循环而不是两个）
2.代码在上下文中工作（在工作簿中进行更改，其中存储代码，而不是在活动工作簿中）

我没有看到将您的代码“优化”为单个for...next循环的其他选项。

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

3 个答案: