Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Создать группы сумм с пределом результата из множества чисел - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Создать группы сумм с пределом результата из множества чисел (Формулы/Formulas)
Создать группы сумм с пределом результата из множества чисел
Кашкар Дата: Пятница, 08.06.2018, 15:34 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Имеется множество чисел в столбце (вероятность нескольких столбцов).
Числа 1 до 100 (вероятность повторения чисел), то есть несколько "1" или несколько "12" и т.д. .
Нужно провести суммирование чисел до (примерно 110), с условием погрешности в меньшую сторону, лишь бы достигнуть результата "меньшее количество групп".
При суммировании, повторение чисел возможно только в его количественном повторении относительно списка.
Если при формировании групп, образуется остаток в виде нескольких чисел, то они отмечаются как остаток.

Заранее спасибо!
К сообщению приложен файл: _Microsoft_Exce.xlsx(14.1 Kb)


Сообщение отредактировал Кашкар - Пятница, 08.06.2018, 21:00
 
Ответить
СообщениеИмеется множество чисел в столбце (вероятность нескольких столбцов).
Числа 1 до 100 (вероятность повторения чисел), то есть несколько "1" или несколько "12" и т.д. .
Нужно провести суммирование чисел до (примерно 110), с условием погрешности в меньшую сторону, лишь бы достигнуть результата "меньшее количество групп".
При суммировании, повторение чисел возможно только в его количественном повторении относительно списка.
Если при формировании групп, образуется остаток в виде нескольких чисел, то они отмечаются как остаток.

Заранее спасибо!

Автор - Кашкар
Дата добавления - 08.06.2018 в 15:34
sboy Дата: Пятница, 08.06.2018, 15:45 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2020
Репутация: 578 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Файл с примером поможет быстрее Вам помочь
 
Ответить
СообщениеДобрый день.
Файл с примером поможет быстрее Вам помочь

Автор - sboy
Дата добавления - 08.06.2018 в 15:45
Кашкар Дата: Понедельник, 11.06.2018, 19:04 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Может есть у кого мысли!?
 
Ответить
СообщениеМожет есть у кого мысли!?

Автор - Кашкар
Дата добавления - 11.06.2018 в 19:04
Светлый Дата: Вторник, 12.06.2018, 11:37 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 564
Репутация: 132 ±
Замечаний: 0% ±

Excel 2007
Немного переделал и по дополнительному столбцу подобрал группы.
Ограничение: В группе не более четырёх слагаемых. Для пяти не хватает ресурсов Excel.
В конце списка подбор вручную остатков.
К сообщению приложен файл: Group-summ.xlsx(28.5 Kb)


Программировать проще, чем писать стихи.

Сообщение отредактировал Светлый - Вторник, 12.06.2018, 13:24
 
Ответить
СообщениеНемного переделал и по дополнительному столбцу подобрал группы.
Ограничение: В группе не более четырёх слагаемых. Для пяти не хватает ресурсов Excel.
В конце списка подбор вручную остатков.

Автор - Светлый
Дата добавления - 12.06.2018 в 11:37
boa Дата: Вторник, 12.06.2018, 14:57 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 134
Репутация: 20 ±
Замечаний: 0% ±

2013, 2016
Кашкар, вариант с макросом во вложении
[vba]
Код
Sub test()

Dim RNG As Range
Dim tempVal&, iMax&, iMin&
Dim MeArr(), tempArr(), ResultArr()
Dim StrTransfer$
Dim i&, j&, x&, y&

    iMax = [G3]
    iMin = [F3]
    Set RNG = Application.InputBox(Prompt:="Выберите дапазон", Title:="", Type:=8)
    tempArr = Application.Transpose(RNG.Value)

    For i = LBound(tempArr) To UBound(tempArr) 'сортируем полученный массив от меньшего к большему
        x = tempArr(i)
        For j = i To UBound(tempArr)
            If tempArr(j) < x Then
                x = tempArr(j): y = tempArr(i)
                tempArr(i) = x: tempArr(j) = y
            End If
        Next j
    Next i
    MeArr = tempArr

    i = 1
    ReDim tempArr(1 To 20, 1 To i)
    Do  'цикл для поиска групп
        j = 1
        tempVal = Val(MeArr(UBound(MeArr))): MeArr(UBound(MeArr)) = "--" 'затираю черточками, что бы потом исключить из массива использованное число
        If tempVal > 120 Then GoTo Propuskaem   'если входное число больше максимально-допустимого, то переходим к следующему

        tempArr(j, i) = tempVal
        For x = LBound(MeArr) To UBound(MeArr) - 1
            If (tempVal + Val(MeArr(x))) = iMax Then
                j = j + 1
                tempArr(j, i) = Val(MeArr(x)): MeArr(x) = "--"
                tempVal = tempVal + tempArr(j, i)
                Exit For

            ElseIf (tempVal + Val(MeArr(x))) > iMax Then
                If tempArr(j, i) = 0 Or x = 1 Then Exit For
                j = j + 1
                tempArr(j, i) = Val(MeArr(x - 1)): MeArr(x - 1) = "--"
                tempVal = tempVal + tempArr(j, i)
                x = LBound(MeArr) - 1

            ElseIf x = UBound(MeArr) - 1 Then       'если дошли до конца массива, а первые два условия не выполнились, то
                For y = x To LBound(MeArr) Step -1  'перебираем массив в обратном порядке и собираем числа с конца массива.
                    If Val(MeArr(y)) > 0 Then Exit For
                Next y
                j = j + 1
                tempArr(j, i) = Val(MeArr(y)): MeArr(y) = "--"
                tempVal = tempVal + tempArr(j, i)
                x = LBound(MeArr) - 1

            ElseIf Val(MeArr(1)) = 0 And (tempVal + Val(MeArr(2))) > iMax Then   '
                Exit For
            End If
        Next x
        If tempVal < iMin Then Exit Do 'если в результат попало число меньше минимального, то пора выходить из цикла
        i = i + 1
        ReDim Preserve tempArr(1 To 20, 1 To i) 'увеличиваем размер массива для сбора результатов

Propuskaem:
' следующие две строки переопределяют размер масива исключая использованные числа
        StrTransfer = Replace(Replace(Join(MeArr, "|"), "|--", ""), "--|", "")
        MeArr = Application.Transpose(Application.Transpose(Split(StrTransfer, "|")))
    Loop
'выводим полученный результат
    x = i - 1
    ReDim ResultArr(1 To x)
    For i = 1 To x
        For j = 1 To 20
            If tempArr(j, i) > 0 Then ResultArr(i) = IIf(j = 1, "", ResultArr(i) & "+") & tempArr(j, i) Else Exit For
        Next j
    Next i

    Cells(2, 9).Resize(UBound(ResultArr)) = Application.Transpose(ResultArr)

'выодим "хвосты" в отдельный столбец
    For j = 1 To 20
        If tempArr(j, i) > 0 Then Cells(1 + j, 8) = tempArr(j, i) Else Exit For
    Next j

End Sub
[/vba]
К сообщению приложен файл: _Microsoft_Exce.xlsb(26.9 Kb)




Сообщение отредактировал boa - Вторник, 12.06.2018, 20:11
 
Ответить
СообщениеКашкар, вариант с макросом во вложении
[vba]
Код
Sub test()

Dim RNG As Range
Dim tempVal&, iMax&, iMin&
Dim MeArr(), tempArr(), ResultArr()
Dim StrTransfer$
Dim i&, j&, x&, y&

    iMax = [G3]
    iMin = [F3]
    Set RNG = Application.InputBox(Prompt:="Выберите дапазон", Title:="", Type:=8)
    tempArr = Application.Transpose(RNG.Value)

    For i = LBound(tempArr) To UBound(tempArr) 'сортируем полученный массив от меньшего к большему
        x = tempArr(i)
        For j = i To UBound(tempArr)
            If tempArr(j) < x Then
                x = tempArr(j): y = tempArr(i)
                tempArr(i) = x: tempArr(j) = y
            End If
        Next j
    Next i
    MeArr = tempArr

    i = 1
    ReDim tempArr(1 To 20, 1 To i)
    Do  'цикл для поиска групп
        j = 1
        tempVal = Val(MeArr(UBound(MeArr))): MeArr(UBound(MeArr)) = "--" 'затираю черточками, что бы потом исключить из массива использованное число
        If tempVal > 120 Then GoTo Propuskaem   'если входное число больше максимально-допустимого, то переходим к следующему

        tempArr(j, i) = tempVal
        For x = LBound(MeArr) To UBound(MeArr) - 1
            If (tempVal + Val(MeArr(x))) = iMax Then
                j = j + 1
                tempArr(j, i) = Val(MeArr(x)): MeArr(x) = "--"
                tempVal = tempVal + tempArr(j, i)
                Exit For

            ElseIf (tempVal + Val(MeArr(x))) > iMax Then
                If tempArr(j, i) = 0 Or x = 1 Then Exit For
                j = j + 1
                tempArr(j, i) = Val(MeArr(x - 1)): MeArr(x - 1) = "--"
                tempVal = tempVal + tempArr(j, i)
                x = LBound(MeArr) - 1

            ElseIf x = UBound(MeArr) - 1 Then       'если дошли до конца массива, а первые два условия не выполнились, то
                For y = x To LBound(MeArr) Step -1  'перебираем массив в обратном порядке и собираем числа с конца массива.
                    If Val(MeArr(y)) > 0 Then Exit For
                Next y
                j = j + 1
                tempArr(j, i) = Val(MeArr(y)): MeArr(y) = "--"
                tempVal = tempVal + tempArr(j, i)
                x = LBound(MeArr) - 1

            ElseIf Val(MeArr(1)) = 0 And (tempVal + Val(MeArr(2))) > iMax Then   '
                Exit For
            End If
        Next x
        If tempVal < iMin Then Exit Do 'если в результат попало число меньше минимального, то пора выходить из цикла
        i = i + 1
        ReDim Preserve tempArr(1 To 20, 1 To i) 'увеличиваем размер массива для сбора результатов

Propuskaem:
' следующие две строки переопределяют размер масива исключая использованные числа
        StrTransfer = Replace(Replace(Join(MeArr, "|"), "|--", ""), "--|", "")
        MeArr = Application.Transpose(Application.Transpose(Split(StrTransfer, "|")))
    Loop
'выводим полученный результат
    x = i - 1
    ReDim ResultArr(1 To x)
    For i = 1 To x
        For j = 1 To 20
            If tempArr(j, i) > 0 Then ResultArr(i) = IIf(j = 1, "", ResultArr(i) & "+") & tempArr(j, i) Else Exit For
        Next j
    Next i

    Cells(2, 9).Resize(UBound(ResultArr)) = Application.Transpose(ResultArr)

'выодим "хвосты" в отдельный столбец
    For j = 1 To 20
        If tempArr(j, i) > 0 Then Cells(1 + j, 8) = tempArr(j, i) Else Exit For
    Next j

End Sub
[/vba]

Автор - boa
Дата добавления - 12.06.2018 в 14:57
Светлый Дата: Четверг, 14.06.2018, 14:55 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 564
Репутация: 132 ±
Замечаний: 0% ±

Excel 2007
Нашёл и исправил ошибки в своих формулах, исключил сложение с самим собой и выбросил из сложения уже использованные. Немного причесал и вычислил остатки.
Формула тяжёлая, считает долго. Больше четырёх слагаемых уже вручную, но это остаток.
Доб.
Сделал, чтобы считал быстрее. Файл перевложил.
К сообщению приложен файл: Group-summ-1.xlsx(26.5 Kb)


Программировать проще, чем писать стихи.

Сообщение отредактировал Светлый - Пятница, 15.06.2018, 09:14
 
Ответить
СообщениеНашёл и исправил ошибки в своих формулах, исключил сложение с самим собой и выбросил из сложения уже использованные. Немного причесал и вычислил остатки.
Формула тяжёлая, считает долго. Больше четырёх слагаемых уже вручную, но это остаток.
Доб.
Сделал, чтобы считал быстрее. Файл перевложил.

Автор - Светлый
Дата добавления - 14.06.2018 в 14:55
Кашкар Дата: Пятница, 15.06.2018, 12:19 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Светлый, практически то что надо!!!
Я в первом файле дал вводные данные упрощенные!!
Сейчас выкладываю файл с данными столбца А, которые использую, и его результат поражает!!!
Считает не долго!!!
Есть некоторые непонятности при подсчетах:
1) В столбце С группа 8, происходит ожидаемый подсчет, так же как и в группах 15,16,17.
Но в группах с 9 по 14 происходит фиксирование максимума без сложения с остатками.
PS: может можно это исправить!? Заодно хвостов меньше будет!

Вопросы:
1) Возможно ли, при суммировании 4 отрезков с получением суммарности не в равном (G3),а в диапазоне от F3 до G3!? Может это поможет при суммировании с остатками.
PS: Или данный диапазон использовать в какой ни будь не сложной формуле (отдельно для хвостов) подсчета остатков (с большим чем 4 суммируемых).
2) Возможно ли, увеличить количество отрезков в столбце А до 200 и более!? Как я понял формулы привязаны к определенному количеству занятых ячеек!
К сообщению приложен файл: Group-summ-__.xlsx(29.2 Kb)
 
Ответить
СообщениеСветлый, практически то что надо!!!
Я в первом файле дал вводные данные упрощенные!!
Сейчас выкладываю файл с данными столбца А, которые использую, и его результат поражает!!!
Считает не долго!!!
Есть некоторые непонятности при подсчетах:
1) В столбце С группа 8, происходит ожидаемый подсчет, так же как и в группах 15,16,17.
Но в группах с 9 по 14 происходит фиксирование максимума без сложения с остатками.
PS: может можно это исправить!? Заодно хвостов меньше будет!

Вопросы:
1) Возможно ли, при суммировании 4 отрезков с получением суммарности не в равном (G3),а в диапазоне от F3 до G3!? Может это поможет при суммировании с остатками.
PS: Или данный диапазон использовать в какой ни будь не сложной формуле (отдельно для хвостов) подсчета остатков (с большим чем 4 суммируемых).
2) Возможно ли, увеличить количество отрезков в столбце А до 200 и более!? Как я понял формулы привязаны к определенному количеству занятых ячеек!

Автор - Кашкар
Дата добавления - 15.06.2018 в 12:19
Светлый Дата: Пятница, 15.06.2018, 13:57 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 564
Репутация: 132 ±
Замечаний: 0% ±

Excel 2007
У меня там ручной подсчёт остатков. Надо выделить вторую группу, которая в рамочке, и протянуть до самого низа. Формулы скопируются так же группами.
Там, где просто максимумы, под ними можно вручную вписывать числа и подгонять сумму. Задействовать для этого две или больше групп. Одна-три группы вручную подгоняется очень просто. В группе справа внизу сумма оставшихся чисел. Если она меньше требуемой, значит это остаток. Для следующего расчёта - формулы можно опять скопировать сверху.
1) В принципе можно.
2) У меня формула на 100. Можно попробовать до 1000 расширить, сколько времени считать будет?
Попытался расширить до 200, закончились ресурсы Excel. Формула только в одной ячейке скушала два с половиной гигабайта оперативки.
Время будет, ещё поиграюсь.


Программировать проще, чем писать стихи.
 
Ответить
СообщениеУ меня там ручной подсчёт остатков. Надо выделить вторую группу, которая в рамочке, и протянуть до самого низа. Формулы скопируются так же группами.
Там, где просто максимумы, под ними можно вручную вписывать числа и подгонять сумму. Задействовать для этого две или больше групп. Одна-три группы вручную подгоняется очень просто. В группе справа внизу сумма оставшихся чисел. Если она меньше требуемой, значит это остаток. Для следующего расчёта - формулы можно опять скопировать сверху.
1) В принципе можно.
2) У меня формула на 100. Можно попробовать до 1000 расширить, сколько времени считать будет?
Попытался расширить до 200, закончились ресурсы Excel. Формула только в одной ячейке скушала два с половиной гигабайта оперативки.
Время будет, ещё поиграюсь.

Автор - Светлый
Дата добавления - 15.06.2018 в 13:57
Светлый Дата: Пятница, 15.06.2018, 17:45 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 564
Репутация: 132 ±
Замечаний: 0% ±

Excel 2007
Сейчас суммы подбирает в диапазоне.
А хвосты придётся крутить вручную :)
А чем предложение boa не устроило?
К сообщению приложен файл: Group-summ-2.xlsx(29.4 Kb)


Программировать проще, чем писать стихи.
 
Ответить
СообщениеСейчас суммы подбирает в диапазоне.
А хвосты придётся крутить вручную :)
А чем предложение boa не устроило?

Автор - Светлый
Дата добавления - 15.06.2018 в 17:45
boa Дата: Пятница, 15.06.2018, 23:22 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 134
Репутация: 20 ±
Замечаний: 0% ±

2013, 2016
Светлый, спасибо
Цитата Светлый, 15.06.2018 в 17:45, в сообщении № 9 ()
А чем предложение boa не устроило?

я думал, что никто не заметил... :( Я ж потратил на его написание не мало времени. ;) Задачка ж нетривиальная...
формулы - это прекрасно, но в большинстве своем, они проиграют алгоритму на VBA.
Макрос всеодно пошевелее формул будет, и это при том, что я его не стремился сделать суппер скоростным для обработки сотен тысяч записей.

нашел ошибку в коде!
вместо:[vba]
Код
If tempVal > 120 Then GoTo Propuskaem
[/vba]
исправьте на: [vba]
Код
If tempVal > iMax Then GoTo Propuskaem
[/vba]

P.S. а еще в новых данных изменился минимальный шаг, что тоже влияет на результат...




Сообщение отредактировал boa - Суббота, 16.06.2018, 00:45
 
Ответить
СообщениеСветлый, спасибо
Цитата Светлый, 15.06.2018 в 17:45, в сообщении № 9 ()
А чем предложение boa не устроило?

я думал, что никто не заметил... :( Я ж потратил на его написание не мало времени. ;) Задачка ж нетривиальная...
формулы - это прекрасно, но в большинстве своем, они проиграют алгоритму на VBA.
Макрос всеодно пошевелее формул будет, и это при том, что я его не стремился сделать суппер скоростным для обработки сотен тысяч записей.

нашел ошибку в коде!
вместо:[vba]
Код
If tempVal > 120 Then GoTo Propuskaem
[/vba]
исправьте на: [vba]
Код
If tempVal > iMax Then GoTo Propuskaem
[/vba]

P.S. а еще в новых данных изменился минимальный шаг, что тоже влияет на результат...

Автор - boa
Дата добавления - 15.06.2018 в 23:22
Светлый Дата: Суббота, 16.06.2018, 16:22 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 564
Репутация: 132 ±
Замечаний: 0% ±

Excel 2007
Если ограничиться остатками не более 20 чисел, то работают формулы для пяти слагаемых.
К сообщению приложен файл: Group-summ-3.xlsx(32.8 Kb)


Программировать проще, чем писать стихи.
 
Ответить
СообщениеЕсли ограничиться остатками не более 20 чисел, то работают формулы для пяти слагаемых.

Автор - Светлый
Дата добавления - 16.06.2018 в 16:22
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Создать группы сумм с пределом результата из множества чисел (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!