循環優化：合併兩個環插入一個

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）不同，否則我將不得不在表格（1）和表格（2）之間添加一個「j」值（從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 

這可以通過使兩維數組的兩個級別工作，爲計算的源和目標提供列索引號。

將對樣本數據進行編譯但不進行現場測試。

Answer 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 。代碼被優化（只有一個for... next循環被寫入而不是兩個）
2.代碼在上下文中工作（在存儲代碼的工作簿中進行更改，而不是在活動的workboo中k）

我沒有看到其他選項將您的代碼「優化」爲單個for...next循環。

Answer 3

您可以用第二次做到這一點（刪除）複製，並在範圍內，以消除環路，即：

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