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

我写了下面的两个循环：

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

任何想法？

Answer 1

这是关于我可以得到它一样紧。

 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 

这是通过使两个二维数组的级别工作，为计算的源和目标提供列索引号。

将对样本数据进行编译，但不进行现场testing。

Answer 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 

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循环。