Как корректно изменить цены, не меняя количество, чтобы сумма по прайсу стала равна заданной, Пропорция и/или скользящее округление формулами, PQ, VBA и прочими инструментами
Дано: 2 столбца (количество "КОЛ" и цена за 1 единицу измерения "ЦЕНА") Задача: получить НОВЫЕ ЦЕНЫ (путём вычисления коэффициента умножения) так, чтобы НОВАЯ СУММА (КОЛ * НОВ ЦЕНА) стала равна заданной (копейка в копейку) Ограничения: • НОВЫЕ цены и суммы должны быть округлены (на самом деле, а не форматом) до 2ух знаков • все количества и цены больше ноля (иначе зачем всё это) • КОЛИЧЕСТВО может НЕ быть целочисленным (это нормальное явление, которое нужно учитывать)
Пропорция в данном случае полностью задачу не решает - остаётся хвост в 5 рублей, который надо куда-то прятать
UPD1: Понял, что задача не так проста, какой показалась. Всё-таки это комбинаторика, а не простая математика и логика Полагаю, что можно свести задачу к виду «Изменить цены, не меняя количества так, чтобы сумма по прайсу стала равна заданной, а также свести к минимуму отклонения коэффициентов каждой цены от среднего коэффициента по всем ценам»
UPD2: VBA. Вариант через пошаговое приближение (принцип, как формулами на листе «скользящее»)
Описание
В коде используется библиотека от bedvit'а — скачать её можно отсюда или придётся закомментировать 2 строки кода (данные и так отсортированы, строки отмечены в коде)
Без комбинаторики и перебора
Очень быстро, несложно, но может НЕ подобрать сумму, хотя это возможно
Принцип подробно описан в коде и визуально отображён на листе «скользящее» (реализован формулами листа)
Кратко: сортируем КОЛИЧЕСТВО по убыванию, потом ЦЕНУ по возрастанию и идём циклом, получая для каждой строки КОЭФФИЦИЕНТ (а также новые ЦЕНУ и СУММУ с учётом округления), уточнённый с учётом предыдущих расчётов
Сортировка позволяет "подбить" сумму за счёт малого КОЛИЧЕСТВА (маленький точный шаг) и большой ЦЕНЫ (отклонение менее заметно)
КОД
Код
Option Explicit
'Option Private Module
'====================================================================================================
Dim BV As New BedvitCOM.VBA ' /// BedVit /// закомментировать, если нет библы
'====================================================================================================
Sub Test()
Dim arr, s#
arr = [_dataSort].Value2 ' забираем в массив 3 столбца: №, КОЛ и ЦЕНА
s = MathProportion(arr, 269488.62, 2) ' вычисляем новые цены
Worksheets.Add after:=Sheets(Sheets.Count): Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr ' добавляем новый лист и выгружаем на него новый массив
If s = 0 Then MsgBox "Data had been successfully reCalculated", vbInformation, "DONE": Exit Sub
MsgBox "There is DIFFERENCE: " & s, vbExclamation, "DIFFERENCE"
End Sub
'====================================================================================================
' Подбор суммы прайса, изменяя цены, методом постепенного приближения (скользящего округления)
'
' Функция изменяет переданный двумерный массив «tmpArr2dKVP» из столбцов «1. КЛЮЧ» (или просто порядковый номер — для сохранения связи, проверяться не будет), «2. КОЛИЧЕСТВО» и «3. ЦЕНА» — для расчётов. Именно в таком порядке
' • будут добавлены столбцы «4. СУММА исх», «5. КОЭФФИЦИЕНТ», «6. ЦЕНА новая», «7. СУММА новая»
' • массив будет отсортирован сначала по убыванию количества, затем по возрастанию цены (нужно для расчёта)
' Вернёт разницу между необходимой и подобранной суммой «sTarget-sNew» (то есть отрицательное значение будет означать ПЕРЕБОР), т.к. не всегда получается выйти в ноль
'
' sTarget = требуемая сумма
' dig = разрядность(требуемая точность) — количество знаков после запятой. Может быть меньше или равной нолю. По умолчанию = 6 (максимальная необходимая точность при подобных расчётах)
'
Private Function MathProportion(ByRef tmpArr2dKVP, ByVal sTarget#, Optional ByVal dig& = 6) As Double
Dim sOld#, sNew#, s#, r&
ReDim Preserve tmpArr2dKVP(1 To UBound(tmpArr2dKVP, 1), 1 To 4) ' добавляем 1 столбец (до 4ёх - для исх СУММЫ), не трогая данные
For r = 1 To UBound(tmpArr2dKVP, 1) ' 1ый цикл. Получаем текущую сумму прайса без округления
tmpArr2dKVP(r, 4) = tmpArr2dKVP(r, 2) * tmpArr2dKVP(r, 3) ' записываем исходную сумму без округления
sOld = sOld + tmpArr2dKVP(r, 4) ' накапливаем общую исходную сумму
Next r
s = sTarget ' запоминаем целевую сумму в другую переменную
BV.ArraySortV tmpArr2dKVP, 2, True, 3, False ' /// BedVit /// (закомментировать, если нет библы) сортируем массив сначала по убыванию количества, затем по возрастанию цены
ReDim Preserve tmpArr2dKVP(1 To UBound(tmpArr2dKVP, 1), 1 To 7) ' добавляем столбцы (до 7ми), не трогая данные
For r = 1 To UBound(tmpArr2dKVP, 1) ' 2ой цикл. Получаем новые цены методом постепенного приближения/уточнения
If r <> 1 Then
sOld = sOld - tmpArr2dKVP(r - 1, 4) ' уменьшаем ИСХОДНУЮ сумму на предыдущее значение
sTarget = sTarget - tmpArr2dKVP(r - 1, 7) ' уменьшаем ЦЕЛЕВУЮ сумму на предыдущее значение
End If
tmpArr2dKVP(r, 5) = sTarget / sOld ' коэффициент пропорции
tmpArr2dKVP(r, 6) = RoundZVI(tmpArr2dKVP(r, 3) * tmpArr2dKVP(r, 5), dig) ' новая ЦЕНА c округлением
tmpArr2dKVP(r, 7) = RoundZVI(tmpArr2dKVP(r, 2) * tmpArr2dKVP(r, 6), dig) ' новая СУММА c округлением
sNew = sNew + tmpArr2dKVP(r, 7)
Next r
MathProportion = RoundZVI(s - sNew, dig)
End Function
'====================================================================================================
'====================================================================================================
Private Function RoundZVI(ByVal v#, Optional ByVal dig&) As Double
If dig < 0 Then
RoundZVI = Round(v / 10 ^ -dig + v * 2E-16, 0) * 10 ^ -dig
Else
RoundZVI = Round(v + v * 2E-16, dig)
End If
If Abs(RoundZVI) = 0 Then RoundZVI = 0
End Function
'====================================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
buchlotnik, Миш, спасибо за вариант. Ты бы хоть там подробнее описал что-ли - куча данных и целой картины не видно)) Я так понимаю, что задача всё-таки для комбинаторики, а не простой математики и логики — сейчас соберу мысли о обновлю шапку темы
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
так я ж без наезда - просто по факту, что не понятно
Цитата
buchlotnik: если например все количества кратны 100, то подбор можно будет осуществить только до рублей
одним из исходов как раз является НЕВОЗМОЖНОСТЬ подобрать заданную сумму
Цитата
buchlotnik: комбинаторика - это простая математика, раз уж я ее понимаю
тогда я тупой, а это не так, а значит всё-таки комбинаторика непростая штука, просто ты умный
Мне надо что-то попроще, чем дискретность и прочие страшные слова. Попробую сделать решение перебором. Руками я делал так: сортируем по количеству (по возрастанию) и далее по цене (по убыванию). Меньше всего будет заметно (минимальное отклонение от коэффициента пропорции) в позициях с маленьким количеством и большой ценой. То есть, если по позиции количество 5, а цена 1 000, то сумму такой позиции можно менять с шагом в 0,01 * 5 = 0,05 (5 копеек), при этом отклонение самой цены с каждым шагом будет 0,01 / 1 000 = 0,00001 (примерно то же, что ты сказал, но своими словами)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
жадный алгоритм - ищет количество с минимальной разницей с искомым, плюсует (или минусует) и далее ищет уже оставшуюся разницу, не трудно заметить, что на нечетных просто циклится
Соблюдение правил форума не освобождает от модераторского произвола
Добавил в шапку вариант на VBA через пошаговое приближение
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Поскольку задача первоначально носила практический характер, то я бы (как бухгалтер) поступил так (аналогично ответу #4): 1. На первом шаге пропорционально изменяем цены (в примере #1 остается разница 4,94) 2. В ручном режиме исправляем разницу строками с наименьшим количеством (в #1 можно поправить ценой по строке 28). По крайней мере, будешь знать, где подгонял под ответ.
sokol92, приветствую и спасибо за ответ! Глаза глазами, а всё-таки бухгалтер решения на основе какой-то аналитики принимает (ты как раз говорил про количество, а я бы ещё и цену учитывал). А значит эту аналитику можно перенести на код (как минимум для надёжности и однообразности подгонов). Попробую сделать вариант с пропорцией и расбросом хвостов, но сразу скажу, что в плане отклонения от коэффициента пропорции он будет хуже Ну а видеть, что и насколько поменялось можно легко - ключи-то тоже передаются
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
БМВ, я про то же. Это и реализовано в VBA, а также визуализировано на листе "скользящее". Беспокоит только, что этот подход всё-таки не замена комбинаторике, которая лучше всего справится с критерием минимального отклонения от среднего коэффициента. Попробую что-то накидать завтра, но ссыкотно) Михаилу Ч написал
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: Как корректно изменить цены, не меняя количество, чтобы сумма по прайсу стала равна заданной
т.е. в сообщении #1 написано, как это не нужно делать? как только будут определены условия задачи - можно будет подумать как ее решать, пока нет условий, а есть только какие-то метания из одного предположения к другому - решать нечего))
Ой, кажется кто-то опять нахлобучился на ночь глядя Проходи мимо, дядь)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
ложь Решил одним из способов. Получил корректный ответ. Что ещё нужно: вариант на комбинаторике как минимум. Есть подозрение, что мой вариант может не выйти на сумму, хотя исход возможен
Цитата
Ігор Гончаренко: нет описания (нет четких критериев, которым должно соответствовать решение)
снова ложь
Цитата
Jack Famous: Полагаю, что можно свести задачу к виду «Изменить цены, не меняя количества так, чтобы сумма по прайсу стала равна заданной, а также свести к минимуму отклонения от среднего коэффициента по всем ценам у полученных коэффициентов для каждой цены
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Ігор Гончаренко, видишь? Ты ничего по делу не пишешь. Только какую-то чепуху несёшь и мусоришь. И так не только у меня. Прошу - не захожи в мои темы, пожалуйста, тебе тут не рады. Если в следующий раз будешь думать, почему я не отвечаю на твою ересь, то приди сюда и перечитай это сообщение
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Ігор Гончаренко, несмотря на мои терки с Jack Famous, тут я с ним полностью согласен. Уж больно часто ты стал выступать, с "задача не ясна, я умываю руки" в разных темах. Никто не заставляет ни делать, ни отписываться. Я понимаю, когда на наводящие вопросы по существу нет ответа , тогда все корректно, но вступить в #14 с таким, после того как даже ответы есть от тех, кто "курсы трактористов" не заканчивал, как минимум странно.
так - а чё я не в курсе, что у нас тёрки какие-то?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Вариант решения: 1. Определяем новые цены для получения нужной суммы, возможны варианты: 1.1. Округляем цены до копеек с учетом пропорционального множителя 1.2. Округляем цены вниз 1.3. Округляем ценны вверх 1.4. Любое другое округление
В результате п.1. получаем приближенную сумму, она может быть больше или меньше искомой
2. Подбираем корректировки цен, которые приведут к минимальному отклонению суммы от нужной Корректируем на целые копейки, задачу сводим к решению задачи "сумма подмножеств" с помощью динамического программирования, где в качестве слагаемых будут количества
3. Для наименьшего отклонения от пропорционального коэффициента: задаем ограничение - на сколько можно менять цену в копейках сортируем цены от наибольшей к наименьшей, что при решении задачи "сумма подмножеств" будет давать корректировки наибольших цен
В примере получилось, что допустимо корректировать цены не более чем на 2 копейки при любом из вариантов первоначального округления.
MCH, огромное спасибо за отличный вариант! Как и ожидалось - вариант подбора является самым оптимальным с точки зрения отклонения: 2 копейки против 8ми в моём VBA-варианте "скользящего приближения" (и ужасные 62 копейки, если вручную) Попробую сделать что-то подобное, но своё. Сижу, разбираюсь …
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Внес поправки в модель: Сделал возможность округлять цены до кратности в копейках (1, 5, 10, 50, 100 копеек), чтобы не было проблем при добавлении к цене НДС и получалось целое число Добавил возможность работать с дробным количеством (3 знака после запятой), за счет округления итоговая сумма может отклоняться от искомой на несколько копеек Дополнил строки, можно использовать перечень из 100 позиций
Не ставил перед собой задачу - поиск наилучшего результата корректировки, при ограничении на сколько копеек можно менять цену и так получится приемлемый результат, который рассчитывается очень быстро
Я тут создал отдельную тему, чтобы написать более универсальное решение, которое подойдёт, в том числе, и для решения ЭТОЙ задачи. Помогите, если сможете, пожалуйста… Тема для написании функции полного (почти) перебора
Краткая суть:
функция для перебора заданного количества значений с анализом каждой комбинации на попадание в диапазон и отсевом ненужных Сильно осложняется тем, что там не совсем всё надо перебирать - из каждой строки брать не более одного значения Будет не очень оптимально и из-за этого долго, зато гарантированно переберёт всё и выведет лучшее Необходима предварительная работа по получению вариантов значений (легко написать отдельную функцию для этого) - зато за счёт этого достигается гибкость
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
В задаче "Сумма подмножеств" (подбор слагаемых под нужную сумму) есть вариант полного перебора с использованием МВиГ и выводом всех возможных вариантов А тот же "рюкзак", если его применить к текущей задаче, лучше решать динамическим программированием, где в качестве цены нужно задать отклонение цены от среднего коэффициента и выбрать тот вариант, в котором будет наименьшее суммарное отклонение.
MCH, прошу, если возможно, сделайте, пожалуйста, в теме вариант функции на основе своих наработок, согласно условий (входящие данные и отчёт)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄