Получилось сделать все формулами, однако работает все очень долго. На подсчет значения в одной ячейке уходит 20-30 секунд, что в пересчете на одну рабочую таблицу займет 4-5 суток)) А у меня этих таблиц несколько десятков.
Дублирую из той темы задачу: Из данных, что есть: столбец "G" с числами. Столбец "F" показывает какое было число в "G" : отрицательное или положительное. В колонке J я указал, какие числа должны получиться в итоге. А теперь, что надо сделать: Для положительных чисел: суммируем ячейки столбца "G" до тех пор, пока сумма не примет отрицательное значение. В колонку "J" заносится максимальное значение, которое получалось при сложении. Для отрицательных чисел: суммируем ячейки столбца "G" до тех пор, пока сумма не примет положительное значение. В колонку "J" заносится минимальное значение, которое получалось при сложении. В колонку "А" я продублировал правила вычислений, чтоб нагляднее было. Если что не понятно, уточните, я со своей колокольни размышляю. Некоторые вещи, которые мне понятны безусловно, могут вызвать вопросы у других. И наоборот
Получилось сделать все формулами, однако работает все очень долго. На подсчет значения в одной ячейке уходит 20-30 секунд, что в пересчете на одну рабочую таблицу займет 4-5 суток)) А у меня этих таблиц несколько десятков.
Дублирую из той темы задачу: Из данных, что есть: столбец "G" с числами. Столбец "F" показывает какое было число в "G" : отрицательное или положительное. В колонке J я указал, какие числа должны получиться в итоге. А теперь, что надо сделать: Для положительных чисел: суммируем ячейки столбца "G" до тех пор, пока сумма не примет отрицательное значение. В колонку "J" заносится максимальное значение, которое получалось при сложении. Для отрицательных чисел: суммируем ячейки столбца "G" до тех пор, пока сумма не примет положительное значение. В колонку "J" заносится минимальное значение, которое получалось при сложении. В колонку "А" я продублировал правила вычислений, чтоб нагляднее было. Если что не понятно, уточните, я со своей колокольни размышляю. Некоторые вещи, которые мне понятны безусловно, могут вызвать вопросы у других. И наоборот astronom
Sub ertert() Dim x, i&, j&, sm#, mx# x = Range("G1", Cells(Rows.Count, "G").End(xlUp)).Value ReDim y(1 To UBound(x), 1 To 1)
For i = 2 To UBound(x) sm = x(i, 1) mx = 0 For j = i + 1 To UBound(x) If Sgn(sm) <> Sgn(x(i, 1)) Then y(i, 1) = mx Exit For Else sm = sm + x(j, 1) If Abs(sm) > Abs(mx) Then mx = sm End If Next j Next i
y(1, 1) = "Что должно получиться" Range("J1").Resize(i - 1).Value = y() End Sub
[/vba]
м.б. как-то так: [vba]
Код
Sub ertert() Dim x, i&, j&, sm#, mx# x = Range("G1", Cells(Rows.Count, "G").End(xlUp)).Value ReDim y(1 To UBound(x), 1 To 1)
For i = 2 To UBound(x) sm = x(i, 1) mx = 0 For j = i + 1 To UBound(x) If Sgn(sm) <> Sgn(x(i, 1)) Then y(i, 1) = mx Exit For Else sm = sm + x(j, 1) If Abs(sm) > Abs(mx) Then mx = sm End If Next j Next i
y(1, 1) = "Что должно получиться" Range("J1").Resize(i - 1).Value = y() End Sub
Ок. Как все это засунуть в нужный столбец? Простите за глупый вопрос, но я считаю себя дубом в этих делах...
дополняю пост:
проверил, все работает, спасибо огромное. подскажите дубу как этот макрос сохранить, чтоб он везде работал? извините за глупые вопросы, приболел, соображалка не варит
Ок. Как все это засунуть в нужный столбец? Простите за глупый вопрос, но я считаю себя дубом в этих делах...
дополняю пост:
проверил, все работает, спасибо огромное. подскажите дубу как этот макрос сохранить, чтоб он везде работал? извините за глупые вопросы, приболел, соображалка не варит astronom
Сообщение отредактировал astronom - Воскресенье, 22.11.2015, 16:22
Не успел я со своим макросом, но выложу, чтобы не пропал. В столбце J значения полученные формулой в начале темы. Формулы заменены на значения. Макрос заполняет столбец К Ошибка при расчете формулой получалась когда в массиве сумм с накоплением не находилось ограничение положительное или отрицательное число. Макрос в этом случае запишет ноль. В макрос вставлен счетчик времени работы.[vba]
Код
Sub Macros() Dim tm!: tm = Timer Application.ScreenUpdating = False Dim iCell As Range Dim AArray As Variant Dim i As Long, j As Long Dim Summ As Long, MinMax As Long Set iCell = Range("G2") ' ячейка с которой начинаются значения "Что есть" AArray = Range(iCell, Cells(Rows.Count, iCell.Column).End(xlUp)).Value For j = 2 To UBound(AArray) Summ = AArray(j - 1, 1): MinMax = Summ + AArray(j, 1) For i = j To UBound(AArray) Summ = Summ + AArray(i, 1) If Sgn(AArray(j - 1, 1)) * MinMax < Sgn(AArray(j - 1, 1)) * Summ Then MinMax = Summ If Sgn(AArray(j - 1, 1)) * Summ < 0 Then Exit For Next i AArray(j - 1, 1) = IIf(i > UBound(AArray), 0, MinMax) Next j iCell.Offset(0, 4).Resize(UBound(AArray), 1) = AArray '4 - смещение относительно G2 начала вывода результата Application.ScreenUpdating = True MsgBox Timer - tm End Sub
[/vba]
Не успел я со своим макросом, но выложу, чтобы не пропал. В столбце J значения полученные формулой в начале темы. Формулы заменены на значения. Макрос заполняет столбец К Ошибка при расчете формулой получалась когда в массиве сумм с накоплением не находилось ограничение положительное или отрицательное число. Макрос в этом случае запишет ноль. В макрос вставлен счетчик времени работы.[vba]
Код
Sub Macros() Dim tm!: tm = Timer Application.ScreenUpdating = False Dim iCell As Range Dim AArray As Variant Dim i As Long, j As Long Dim Summ As Long, MinMax As Long Set iCell = Range("G2") ' ячейка с которой начинаются значения "Что есть" AArray = Range(iCell, Cells(Rows.Count, iCell.Column).End(xlUp)).Value For j = 2 To UBound(AArray) Summ = AArray(j - 1, 1): MinMax = Summ + AArray(j, 1) For i = j To UBound(AArray) Summ = Summ + AArray(i, 1) If Sgn(AArray(j - 1, 1)) * MinMax < Sgn(AArray(j - 1, 1)) * Summ Then MinMax = Summ If Sgn(AArray(j - 1, 1)) * Summ < 0 Then Exit For Next i AArray(j - 1, 1) = IIf(i > UBound(AArray), 0, MinMax) Next j iCell.Offset(0, 4).Resize(UBound(AArray), 1) = AArray '4 - смещение относительно G2 начала вывода результата Application.ScreenUpdating = True MsgBox Timer - tm End Sub
Public Sub check1() Dim arrG, arr2() As Double Dim i As Integer, j As Integer Dim sum As Double, sumOut As Double Dim flg1 As Byte, flg2 As Byte Const numCln As Byte = 7 Const outCln As Byte = 9 Const startRow As Byte = 2
With Worksheets("basa") j = Cells(Rows.Count, numCln).End(xlUp).Row
For i = 1 To UBound(arrG) - 1 sum = arrG(i, 1) sumOut = sum + arrG(i + 1, 1) j = i
Do j = j + 1 sum = sum + arrG(j, 1)
If arrG(i, 1) < 0 Then If sumOut > sum Then sumOut = sum Else If sumOut < sum Then sumOut = sum End If flg1 = Abs(Sgn(sum) <> Sgn(arrG(i, 1))) flg2 = Abs(j > UBound(arrG) - 1)
Loop Until (flg1) Or (flg2) If flg1 <> 0 Then arr2(i, 1) = sumOut Else: arr2(i, 1) = 0 'перехода нет End If
Next i .Range("J2").Resize(UBound(arr2)).Value = arr2()
End With End Sub
[/vba]
если не наврал то так
[vba]
Код
Public Sub check1() Dim arrG, arr2() As Double Dim i As Integer, j As Integer Dim sum As Double, sumOut As Double Dim flg1 As Byte, flg2 As Byte Const numCln As Byte = 7 Const outCln As Byte = 9 Const startRow As Byte = 2
With Worksheets("basa") j = Cells(Rows.Count, numCln).End(xlUp).Row
For i = 1 To UBound(arrG) - 1 sum = arrG(i, 1) sumOut = sum + arrG(i + 1, 1) j = i
Do j = j + 1 sum = sum + arrG(j, 1)
If arrG(i, 1) < 0 Then If sumOut > sum Then sumOut = sum Else If sumOut < sum Then sumOut = sum End If flg1 = Abs(Sgn(sum) <> Sgn(arrG(i, 1))) flg2 = Abs(j > UBound(arrG) - 1)
Loop Until (flg1) Or (flg2) If flg1 <> 0 Then arr2(i, 1) = sumOut Else: arr2(i, 1) = 0 'перехода нет End If
Next i .Range("J2").Resize(UBound(arr2)).Value = arr2()
Да ну? Какие числа были присуммировании "224,409,158,384,212,477,-16. На отрицательном числе суммирование окончено" 224 -147 388 -142 278 -366 148 И что общего? Не нашел ни одного места, где после 224 встречается 409
Да ну? Какие числа были присуммировании "224,409,158,384,212,477,-16. На отрицательном числе суммирование окончено" 224 -147 388 -142 278 -366 148 И что общего? Не нашел ни одного места, где после 224 встречается 409RAN
Быть или не быть, вот в чем загвоздка!
Сообщение отредактировал RAN - Воскресенье, 22.11.2015, 19:39
Если убрать ошибку автора вопроса, то массив для первой ячейки такой 529+(-305)=224 224+185=409 409+(-251)=158 158+226=384 384+(171)=213 213+265=478 478+(-492)=-14
Если убрать ошибку автора вопроса, то массив для первой ячейки такой 529+(-305)=224 224+185=409 409+(-251)=158 158+226=384 384+(171)=213 213+265=478 478+(-492)=-14AlexM
Номер мобильного модема (без голосовой связи) 9269171249 МегаФон, Московский регион.
Сообщение отредактировал AlexM - Воскресенье, 22.11.2015, 19:50