Как и в случае со всеми усилиями героев c, предпринимаемыми вопреки всему, ваша попытка кодирования действительно вдохновляет. Я сократил ваш код, но этого недостаточно. Как вы, возможно, видите, средняя часть повторяется дважды, один раз для столбца 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. Это сокращает пробег до одного l oop. Я подумал, что, возможно, ты никогда не видел результат своих трудов. В некоторых случаях вы конвертируете столбцы в строки, и чтобы спасти мою жизнь, я не смог бы сказать, куда поместить следующую строку ваших данных, не говоря уже о тех 999 998, на которые вы надеялись. Я сократил это число до фактического количества строк в вашей рабочей таблице, но это не проблема. Непосредственная проблема заключается в том, куда поместить следующий набор данных или как этот набор данных может отличаться от того, который генерирует код.