Добрый день уважаемые специалисты и просто гуру Excel VBA! 1.Есть таблица из 12 значений. 2.Есть итоговое значение у каждого из 12. 3.Есть очерёдность по которой надо вычитать из итогового значения Допустим что итоговое значения 250 а 12 значений которые надо по очереди вычитать (0, 0, 50, 0, 0, 0, 0, 300, 0, 0, 0, 0) Действия примерно такие вычитаем из итога по очереди каждое число 250 - 0, 250 - 0, 250 - 50 .... и так далее пока 250 не будет отрицательным значением на 8 значении где стоит 300 у нас получится -50 а результат должен быть таким (0, 0, 50, 0, 0, 0, 0, 200, 0, 0, 0, 0)250 смысл в том что сумма 12 значений должна быть равна итоговому значению
Добрый день уважаемые специалисты и просто гуру Excel VBA! 1.Есть таблица из 12 значений. 2.Есть итоговое значение у каждого из 12. 3.Есть очерёдность по которой надо вычитать из итогового значения Допустим что итоговое значения 250 а 12 значений которые надо по очереди вычитать (0, 0, 50, 0, 0, 0, 0, 300, 0, 0, 0, 0) Действия примерно такие вычитаем из итога по очереди каждое число 250 - 0, 250 - 0, 250 - 50 .... и так далее пока 250 не будет отрицательным значением на 8 значении где стоит 300 у нас получится -50 а результат должен быть таким (0, 0, 50, 0, 0, 0, 0, 200, 0, 0, 0, 0)250 смысл в том что сумма 12 значений должна быть равна итоговому значениюElhust
Public Sub RCHe(SOURSE As Range, ИТОГ, REZ As Range) If SOURSE.Count <> REZ.Count Or SOURSE.Rows.Count > 1 Then Exit Sub Dim arr1(), arr2(), summ, cell arr1 = SOURSE.Value arr2 = REZ.Value For f = 1 To SOURSE.Columns.Count If arr1(1, f) > 0 Then If ИТОГ - summ - arr1(1, f) <= 0 Then REZ.Cells(1, f).Value = ИТОГ - summ summ = ИТОГ Else REZ.Cells(1, f).Value = arr1(1, f) summ = summ + arr1(1, f) End If End If Next f REZ.Activate End Sub
Sub test() For f = 3 To 16 RCHe ActiveSheet.Range("A" & f & ":L" & f), ActiveSheet.Cells(f, 13).Value, ActiveSheet.Range("Q" & f & ":AB" & f) Next f End Sub
[/vba]
так нужно?
[vba]
Код
Public Sub RCHe(SOURSE As Range, ИТОГ, REZ As Range) If SOURSE.Count <> REZ.Count Or SOURSE.Rows.Count > 1 Then Exit Sub Dim arr1(), arr2(), summ, cell arr1 = SOURSE.Value arr2 = REZ.Value For f = 1 To SOURSE.Columns.Count If arr1(1, f) > 0 Then If ИТОГ - summ - arr1(1, f) <= 0 Then REZ.Cells(1, f).Value = ИТОГ - summ summ = ИТОГ Else REZ.Cells(1, f).Value = arr1(1, f) summ = summ + arr1(1, f) End If End If Next f REZ.Activate End Sub
Sub test() For f = 3 To 16 RCHe ActiveSheet.Range("A" & f & ":L" & f), ActiveSheet.Cells(f, 13).Value, ActiveSheet.Range("Q" & f & ":AB" & f) Next f End Sub