Question

我已经嵌套了＃34; Do While＆＃34;在下面的代码底部附近循环，没有递增。我已经逐步完成了代码，并确认一旦在＆＃34; Outages＆＃34;的单元格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

表格（“停电”）。选择不合适。

Excel VBA - 嵌套执行循环不递增

1 个答案: