Excel VBA-嵌套的Do While循环不递增

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

Sheets（“停运”）。选择不正确。