Подведение итогов работы al oop в VBA, Excel - PullRequest
0 голосов
/ 17 апреля 2020

Я пытаюсь суммировать результаты всех oop. Пока что код принимает значения из WsIn по строкам, пропускает их через модель и выдает результаты в WsOut. Код принимает значения в строке 1 и выдает результаты, основанные на них, и возвращает их назад и делает это для строки 2 и так далее. Результаты перезаписываются новыми результатами по мере зацикливания кода. Но я хочу, чтобы он добавил результаты, приведенные в строке 1, к результатам, представленным в строке 2, добавленных в строку 3, et c. Результаты представлены в диапазонах C5: C33 и D5: D33 в WsOut. Я думаю, что код для этого будет что-то вроде l oop, который я положил внизу, но я не уверен, как это сделать. Есть идеи, что мне делать?

Sub TEST1()

Dim WsIn As Worksheet               ' Input
Dim WsT As Worksheet                ' Taken
Dim WsOut As Worksheet              ' Output
Dim WsMod As Worksheet              ' Model
Dim Arr As Variant
Dim Rl As Long
Dim R As Long
Dim Rout As Long                    ' WsOut row
Dim Cmod As Long                    ' WsMod column

Dim XXX As Integer
Dim YYY As Integer
Dim WWW As Integer



Set WsT = Sheets("Inputs Taken")
Set WsIn = Sheets("Input Values")
Set WsOut = Sheets("Output")
Set WsMod = Sheets("Model")





Application.ScreenUpdating = False
Rl = WsIn.Cells(WsIn.Rows.Count, "B").End(xlUp).Row
For R = 2 To Rl
    'Pasting Input Values into Inputs Taken
    With WsIn
        Arr = .Range(.Cells(R, 1), .Cells(R, 4)).Value
        WsT.Cells(5, "D").Resize(UBound(Arr, 2), UBound(Arr)) _
                         .Value = Application.Transpose(Arr)
        Arr = .Range(.Cells(R, 5), .Cells(R, 6)).Value
        WsT.Cells(11, "C").Resize(UBound(Arr), UBound(Arr, 2)).Value = Arr
        Arr = .Range(.Cells(R, 7), .Cells(R, 8)).Value
        WsT.Cells(16, "C").Resize(UBound(Arr), UBound(Arr, 2)).Value = Arr
        Arr = .Range(.Cells(R, 9), .Cells(R, 14)).Value
        WsT.Cells(9, "G").Resize(UBound(Arr, 2), UBound(Arr)) _
                         .Value = Application.Transpose(Arr)
        Arr = .Range(.Cells(R, 15), .Cells(R, 16)).Value
        WsT.Cells(20, "C").Resize(UBound(Arr, 2), UBound(Arr)) _
                         .Value = Application.Transpose(Arr)
        Arr = .Range(.Cells(R, 17), .Cells(R, 18)).Value
        WsT.Cells(20, "D").Resize(UBound(Arr, 2), UBound(Arr)) _
                         .Value = Application.Transpose(Arr)


    End With

    'Setting Opening PUP to 100% and refreshing
    WsT.Cells(5, "G").Value = 1
    Application.CalculateFull

    'Calculating No RPs
    With WsOut
        Cmod = 62                       ' BJ:BP
        For Rout = 7 To 13
                .Cells(Rout, "C").Value = SumProduct(Cmod, WsMod)
                Cmod = Cmod + 1
        Next Rout
        .Cells(14, 3).Value = Application.Sum(.Range("C11:C13"))

        Cmod = 71                       ' BS:CB
        For Rout = 17 To 26
            .Cells(Rout, "C").Value = SumProduct(Cmod, WsMod, True)
            Cmod = Cmod + 1
        Next Rout
        .Cells(5, 3).Value = WsMod.Cells(6, "BL").Value _
                           - WsMod.Cells(6, "BS").Value _
                           - WsMod.Cells(6, "BT").Value
        .Cells(15, 3).Value = Application.Sum(.Range("C5,C7:C10, C14"))
        .Cells(27, 3).Value = Application.Sum(.Range("C17:C26"))
        .Cells(29, 3).Value = Application.Sum(WsMod.Range("AN6:AN365"))
        .Cells(30, 3).Value = Application.Sum(WsMod.Range("AP6:AP365"))
        .Cells(31, 3).Value = WsOut.Cells(2, 3).Value
        .Cells(33, 3).Value = WsOut.Cells(15, 3) - Application.Sum(.Range("C29:C31, C27"))
    End With

    'Changing PUP rate
    WsT.Cells(5, "G").Value = 0
    Application.CalculateFull


    'Calculate with RP
    With WsOut
        Cmod = 62                       ' BJ:BP
        For Rout = 7 To 13
                .Cells(Rout, "D").Value = SumProduct(Cmod, WsMod)
                Cmod = Cmod + 1
        Next Rout
        .Cells(14, 4).Value = Application.Sum(.Range("D11:D13"))

        Cmod = 71                       ' BS:CB
        For Rout = 17 To 26
            .Cells(Rout, "D").Value = SumProduct(Cmod, WsMod, True)
            Cmod = Cmod + 1
        Next Rout
        .Cells(5, 4).Value = WsMod.Cells(6, "BL").Value _
                           - WsMod.Cells(6, "BS").Value _
                           - WsMod.Cells(6, "BT").Value
        .Cells(15, 4).Value = Application.Sum(.Range("D5,D7:D10, D14"))
        .Cells(27, 4).Value = Application.Sum(.Range("D17:D26"))
        .Cells(29, 4).Value = Application.Sum(WsMod.Range("AN6:AN365"))
        .Cells(30, 4).Value = Application.Sum(WsMod.Range("AP6:AP365"))
        .Cells(31, 4).Value = WsOut.Cells(2, 3).Value
        .Cells(33, 4).Value = WsOut.Cells(15, 4) - Application.Sum(.Range("D29:D31, D27"))
    End With

'Exit For
    Next R
    Application.ScreenUpdating = True

        For XXX = 5 To 33
        For YYY = 6 To 7
         For WWW = 3 To 4
           WsOut.Cells(XXX, YYY).Value = WsOut.Cells(XXX, WWW).Value

    Next WWW
    Next YYY
    Next XXX


End Sub

Private Function SumProduct(ByVal Cmod As Long, _
                            WsMod As Worksheet, _
                            Optional ByVal Negative As Boolean) As Double
    Dim AuxRng As Range

    With WsMod
        Set AuxRng = .Range(.Cells(6, Cmod), .Cells(365, Cmod))
        SumProduct = Application.SumProduct( _
                    .Range("AD6:AD365"), _
                    .Range("AG6:AG365"), _
                     AuxRng)
    End With
End Function

1 Ответ

1 голос
/ 17 апреля 2020

Добавьте целое число к себе в конце каждого l oop. totNum = totNum + это количество строк. В конце общая сумма будет = totNum.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...