堆棧內存溢出
  簡體   English   中英

如何對 VBA、Excel 中完成的每個循環的結果求和？

[英]How do I sum the results of each loop done in VBA, Excel?

 原文  2020-04-09 11:41:08  7   1    excel/ vba/ loops

問題描述

另外，如何阻止循環接收空單元格？ 我已經嘗試過 Do While 和 Do until 但它仍然會占用空單元格。 我希望代碼一次取一行輸入值選項卡中的值，並為每個值提供結果，直到一個空單元格。 然后對每行輸入給出的結果求和。 這是我到目前為止的代碼。 計算本身有效，但循環無效。

'''

Sub TEST()

Dim i As Long
For i = 1 To 1000000
i = i + 1

'Pasting Input Values into Inputs Taken
Sheets("Input Values").Range("A" & i).Copy
Sheets("Inputs Taken").Range("D5").PasteSpecial xlPasteValues
Sheets("Input Values").Range("B" & i).Copy
Sheets("Inputs Taken").Range("D6").PasteSpecial xlPasteValues
Sheets("Input Values").Range("C" & i).Copy
Sheets("Inputs Taken").Range("D7").PasteSpecial xlPasteValues
Sheets("Input Values").Range("D" & i).Copy
Sheets("Inputs Taken").Range("D8").PasteSpecial xlPasteValues
Sheets("Input Values").Range("E" & i).Copy
Sheets("Inputs Taken").Range("C11").PasteSpecial xlPasteValues
Sheets("Input Values").Range("F" & i).Copy
Sheets("Inputs Taken").Range("D11").PasteSpecial xlPasteValues
Sheets("Input Values").Range("G" & i).Copy
Sheets("Inputs Taken").Range("C16").PasteSpecial xlPasteValues
Sheets("Input Values").Range("H" & i).Copy
Sheets("Inputs Taken").Range("D16").PasteSpecial xlPasteValues
Sheets("Input Values").Range("I" & i).Copy
Sheets("Inputs Taken").Range("G9").PasteSpecial xlPasteValues
Sheets("Input Values").Range("J" & i).Copy
Sheets("Inputs Taken").Range("G10").PasteSpecial xlPasteValues
Sheets("Input Values").Range("K" & i).Copy
Sheets("Inputs Taken").Range("G11").PasteSpecial xlPasteValues
Sheets("Input Values").Range("L" & i).Copy
Sheets("Inputs Taken").Range("G12").PasteSpecial xlPasteValues
Sheets("Input Values").Range("M" & i).Copy
Sheets("Inputs Taken").Range("G13").PasteSpecial xlPasteValues
Sheets("Input Values").Range("N" & i).Copy
Sheets("Inputs Taken").Range("G14").PasteSpecial xlPasteValues

'Setting Opening PUP to 100% and refreshing
Sheets("Inputs Taken").Range("G5").Value = 1
Application.CalculateFull

'Calculating No RPs
Sheets("Output").Range("C7").Formula = _
        "=SUMPRODUCT(Model!BJ6:BJ365,Model!AD6:AD365,Model!AG6:AG365)"
Sheets("Output").Range("C8").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BK6:BK365)"
Sheets("Output").Range("C10").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BM6:BM365)"
Sheets("Output").Range("C11").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BN6:BN365)"
Sheets("Output").Range("C12").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BO6:BO365)"
Sheets("Output").Range("C13").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BP6:BP365)"
Sheets("Output").Range("C14").Formula = "=SUM(Output!C11:C13)"
Sheets("Output").Range("C17").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BS6:BS365)"
Sheets("Output").Range("C18").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BT6:BT365)"
Sheets("Output").Range("C19").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BU6:BU365)"
Sheets("Output").Range("C20").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BV6:BV365)"
Sheets("Output").Range("C21").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BW6:BW365)"
Sheets("Output").Range("C22").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BX6:BX365)"
Sheets("Output").Range("C23").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BY6:BY365)"
Sheets("Output").Range("C24").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BZ6:BZ365)"
Sheets("Output").Range("C25").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!CA6:CA365)"
Sheets("Output").Range("C26").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!CB6:CB365)"

Sheets("Output").Range("C5").Formula = "=Model!BL6-Model!BS6-Model!BT6"
Sheets("Output").Range("C15").Formula = "=SUM(Output!C7:C10,Output!C14)"
Sheets("Output").Range("C27").Formula = "=SUM(Output!C17:C26)"
Sheets("Output").Range("C29").Formula = "=-SUM(Model!AN6:AN365)"
Sheets("Output").Range("C30").Formula = "=-SUM(Model!AP6:AP365)"
Sheets("Output").Range("C31").Formula = "=-Output!C2"
Sheets("Output").Range("C33").Formula = "=SUM(Output!C29:C31,Output!C27,Output!C15)"

'Removing Formulas from output
Sheets("Output").Range("C5:C33").Copy
Sheets("Output").Range("C5:C33").PasteSpecial xlPasteValues

'Changing PUP rate
Sheets("Inputs Taken").Range("G5").Value = 0
Application.CalculateFull

'Calculate with RP
Sheets("Output").Range("D7").Formula = _
        "=SUMPRODUCT(Model!BJ6:BJ365,Model!AD6:AD365,Model!AG6:AG365)"
Sheets("Output").Range("D8").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BK6:BK365)"
Sheets("Output").Range("D10").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BM6:BM365)"
Sheets("Output").Range("D11").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BN6:BN365)"
Sheets("Output").Range("D12").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BO6:BO365)"
Sheets("Output").Range("D13").Formula = _
        "=SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BP6:BP365)"
Sheets("Output").Range("D14").Formula = "=SUM(Output!D11:D13)"
Sheets("Output").Range("D17").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BS6:BS365)"
Sheets("Output").Range("D18").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BT6:BT365)"
Sheets("Output").Range("D19").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BU6:BU365)"
Sheets("Output").Range("D20").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BV6:BV365)"
Sheets("Output").Range("D21").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BW6:BW365)"
Sheets("Output").Range("D22").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BX6:BX365)"
Sheets("Output").Range("D23").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BY6:BY365)"
Sheets("Output").Range("D24").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!BZ6:BZ365)"
Sheets("Output").Range("D25").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!CA6:CA365)"
Sheets("Output").Range("D26").Formula = _
        "=-SUMPRODUCT(Model!AD6:AD365,Model!AG6:AG365,Model!CB6:CB365)"

Sheets("Output").Range("D5").Formula = "=Model!BL6-Model!BS6-Model!BT6"
Sheets("Output").Range("D15").Formula = "=SUM(Output!D7:D10,Output!D14)"
Sheets("Output").Range("D27").Formula = "=SUM(Output!D17:D26)"
Sheets("Output").Range("D29").Formula = "=-SUM(Model!AN6:AN365)"
Sheets("Output").Range("D30").Formula = "=-SUM(Model!AP6:AP365)"
Sheets("Output").Range("D31").Formula = "=-Output!C2"
Sheets("Output").Range("D33").Formula = "=SUM(Output!D29:D31,Output!D27,Output!D15)"

'Removing Formulas from output
Sheets("Output").Range("D5:D33").Copy
Sheets("Output").Range("D5:D33").PasteSpecial xlPasteValues


If Sheets("Input Values").Cells(i, 2).Value = "" Then Exit For
Next i

End Sub

'''

1 個解決方案

解決方案1
 0  2020-04-09 14:37:20

就像所有不顧一切的英勇努力一樣，您的編碼嘗試確實令人鼓舞。 我已經減少了你的代碼，但還不夠。 正如您可能看到的那樣，中間部分重復了兩次，一次是針對 C 列，然后是 D 列，這應該通過兩次調用相同的過程來實現，只有一個不同的參數。 也許你會在復活節假期把它作為你的任務:-) 這是你修改后的代碼。

Sub TEST()

    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


    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 = 1 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)
        End With

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

        'Calculating No RPs
        With WsOut
            Cmod = 62                       ' BJ:BP
            For Rout = 7 To 13
                If Rout <> 9 Then           ' skip result in C9
                    .Cells(Rout, "C").Value = SumProduct(Cmod, WsMod)
                    Cmod = Cmod + 1
                End If
            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("C7:C10, C14"))
            .Cells(27, 3).Value = Application.Sum(.Range("C17:C26"))
            .Cells(29, 3).Value = Application.Sum(WsMod.Range("AN6:AN365")) * -1
            .Cells(30, 3).Value = Application.Sum(WsMod.Range("AP6:AP365")) * -1
            .Cells(31, 3).Value = WsOut.Cells(2, 3).Value * -1
            .Cells(33, 3).Value = Application.Sum(.Range("C29:C31, C15, C27"))
        End With

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

        'Calculate with RP
        With WsOut
            Cmod = 62                       ' BJ:BP
            For Rout = 7 To 13
                If Rout <> 9 Then           ' skip result in D9
                    .Cells(Rout, "D").Value = SumProduct(Cmod, WsOut)
                    Cmod = Cmod + 1
                End If
            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, WsOut, 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("D7:D10, D14"))
            .Cells(27, 4).Value = Application.Sum(.Range("D17:D26"))
            .Cells(29, 4).Value = Application.Sum(WsMod.Range("AN6:AN365")) * -1
            .Cells(30, 4).Value = Application.Sum(WsMod.Range("AP6:AP365")) * -1
            .Cells(31, 4).Value = WsOut.Cells(2, 3).Value * -1
            .Cells(33, 4).Value = Application.Sum(.Range("D29:D31, D15, D27"))
        End With

Exit For
    Next R
    Application.ScreenUpdating = True
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) * IIf(Negative, -1, 1)
    End With
End Function

我提請您注意主程序的結尾，它顯示Exit For 。 這將運行縮減為單個循環。 我想，也許你從來沒有看到你的勞動成果。 在某些情況下，您正在將列轉換為行，為了挽救我的生命，我無法確定將下一行數據放在哪里，更不用說您希望的 999,998。 我已將該數字減少到工作表中的實際行數，但這不是問題。 直接的問題是在哪里放置下一個數據集 - 或者該數據集與代碼現在生成的數據集有何不同。

暫無
暫無

聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

相關問題 如何在VBA中為每個循環獲取索引（使用Excel編程）？ 對於Excel VBA中的每個循環，我如何引用公式中的單元格地址？ 如何為 Excel 在 VBA 中聲明（Dim）應用程序匹配的總和？ 對於每個循環，Excel VBA 每個循環的VBA Excel 對於 VBA Excel 中的每個循環 如何為每個VBA Excel將inputbox輸入分配給變量 Excel VBA在For-Next循環中顯示每次迭代的結果 Excel VBA-Loop＆IF語句結果不是靜態的，並且在每次新運行時都會更新 Excel/宏/電子郵件。 如何從此 VBA 代碼中刪除循環功能並單獨運行每一行？
相關標簽
 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM