Excel VBA - 嵌套但循環不增量

Question

我在下面的代碼底部附近嵌套了「Do While」循環，這些循環不增加。我已經瀏覽了代碼，並確認在「停機」選項卡的單元格E37中發現非零值後，代碼將不斷爲該值找到解決方案，而不是增加公司代碼。公司和貿易伙伴的號碼採用B2：AE31的矩陣表示。這是一個會計應用程序，用於確定公司和貿易伙伴之間哪些公司間帳戶不平衡。基本上，這個宏需要遍歷公司代碼和貿易伙伴的所有值組合（每個組合爲1:27）。任何幫助，你可以給予讚賞。

'4 - Identify outages in table (loop through) 
Dim i As Integer 
Dim j As Integer 
Dim CO As String 
Dim TP As String 
Dim MO As Integer 
Dim SolverValue As Double 

i = 1 'Company code 
j = 1 'Trading partner 
MO = Sheets("Inputs").Range("B1").Value2 

Do While i < 28 
    Range("E34").Value2 = i 
    j = 1 

    Do While j < 28 
    Range("E35").Value2 = j 
    Sheets("Outages").Select 
    If Range("E37").Value2 <> 0 Then 
     CO = Range("E34").Value2 
     TP = Range("E35").Value2 

    '4a - Run solver for companies if an outage is found 
    ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count) 
    ActiveSheet.Name = "Solver" 

    Sheets("Transactions").Select 
    Cells.Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$1:$R$10000").AutoFilter Field:=2, Criteria1:=MO 
    ActiveSheet.Range("$A$1:$R$10000").AutoFilter Field:=9, Criteria1:=CO, _ 
     Operator:=xlOr, Criteria2:=TP 
    ActiveSheet.Range("$A$1:$R$10000").AutoFilter Field:=11, Criteria1:=CO, _ 
     Operator:=xlOr, Criteria2:=TP 
    ActiveSheet.Range("$A$1:$R$10000").AutoFilter Field:=18, Criteria1:="1" 
    Sheets("Transactions").Select 
    Rows("1:10000").Select 
    Selection.Copy 
    Sheets("Solver").Select 
    Rows("1:1").Select 
    ActiveSheet.Paste 
    Columns("A:A").EntireColumn.AutoFit 
    Cells.Select 
    Cells.EntireColumn.AutoFit 
    Range("Q1").Select 
    Application.CutCopyMode = False 
    ActiveCell.FormulaR1C1 = "=+SUM(R[1]C:R[201]C)" 
    Range("Q2").Select 
    ActiveWindow.SmallScroll Down:=-18 
    ActiveCell.FormulaR1C1 = "=+RC[-3]*RC[-1]" 
    Range("Q2").Select 
    Selection.Copy 
    Range("Q3:Q203").Select 
    ActiveSheet.Paste 
    Range("P2").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Range("P3:P203").Select 
    ActiveSheet.Paste 
    Range("R1").Select 
    ActiveWindow.SmallScroll ToRight:=4 
    Sheets("Outages").Select 
    Range("E37").Select 
    Selection.Copy 
    Sheets("Solver").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Application.CutCopyMode = False 
    Selection.Copy 
    Selection.Style = "Comma" 

    SolverReset 
    SolverValue = Sheets("Outages").Range("E37") 
     SolverOk SetCell:="$Q$1", MaxMinVal:=3, ValueOf:=SolverValue, ByChange:= _ 
     "$P$2:$P$201", Engine:=2, EngineDesc:="Simplex LP" 
    SolverAdd CellRef:="$P$2:$P$201", Relation:=5, FormulaText:="binary" 
    SolverSolve True 
    Columns("P:R").Select 
    Columns("P:R").EntireColumn.AutoFit 

    '4b - Copy entries causing outages to a list 
    Cells.Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$1:$W$201").AutoFilter Field:=16, Criteria1:="1.00" 
    Range("A2:Q1000").Select 
    Selection.Copy 
    Sheets("Transactions Causing Outages").Select 
    Range("A2").Select 
    ActiveSheet.Paste 
    Columns("N:Q").Select 
    Application.CutCopyMode = False 
    Selection.Delete Shift:=xlToLeft 
    Cells.Select 
    Cells.EntireColumn.AutoFit 

    '4c - Delete Solver tab 
    Application.DisplayAlerts = False 
    Worksheets("Solver").Delete 
    Application.DisplayAlerts = True 

    Worksheets("Transactions").ShowAllData 'Unfilter the transactions tab 

    End If 

    j = j + 1 

    Loop 

i = i + 1 

Loop 

Answer 1

表（「Outages」）。選擇是不合適的。