Прогрессивное налогообложение. Реализация кодом, функциями листа, Power Query и другими инструментами, Progressive tax in VBA, WorksheetFunction, Power Query and other
Скрин с вики про подоходный налог и таблица расчёта (есть в файле)
VBA
Код
Option Explicit
Option Private Module
'====================================================================================================
Sub Test()
Dim v, arrV(), res#, t!, tt!, n&
arrV = Array(19000, 39000, 59000, 79000, 99000, 199000): tt = Timer
For Each v In arrV
t = Timer
For n = 1 To 10000000
res = TaxProgressive(v)
Next n
Debug.Print v, res, Timer - t
Next v
Debug.Print "Total time (6 values in 10 mln cycles):"; Timer - tt
End Sub
'====================================================================================================
'====================================================================================================
' Прогрессивное налогообложение на примере подоходного налога. Результат с точностью до копеек (математическое округление)
' Post: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=5&TID=142573&TITLE_SEO=142573-progressivnoe-nalogooblozhenie.-realizatsiya-kodom_-funktsiyami-lista_-power-query-i-drugimi-instrumentami
Function TaxProgressive(iVal) As Double
If iVal < 20001 Then TaxProgressive = RoundZVI(iVal * 0.12, 2): Exit Function
If iVal < 40001 Then TaxProgressive = 2400 + RoundZVI((iVal - 20000) * 0.15, 2): Exit Function
If iVal < 60001 Then TaxProgressive = 5400 + RoundZVI((iVal - 40000) * 0.2, 2): Exit Function
If iVal < 80001 Then TaxProgressive = 9400 + RoundZVI((iVal - 60000) * 0.25, 2): Exit Function
If iVal < 100001 Then TaxProgressive = 14400 + RoundZVI((iVal - 80000) * 0.3, 2): Exit Function
TaxProgressive = 20400 + RoundZVI((iVal - 100000) * 0.35, 2)
End Function
'====================================================================================================
' Функция от ZVI: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=8&TID=3483&TITLE_SEO=3483&MID=303275#message303275
'====================================================================================================
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
'====================================================================================================
В расчёт общего времени выполнения ВКЛЮЧЕНО время вывода Debug.Print
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
не помню, чтобы вы как-то зарекомендовали себя как автора примитивных решений, и тем более, не помню, чтобы я вам такое говорил По-моему, замечательное решение, вся аналитика, несложные формулы - мне всё нравится
Скрин
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Разделители поменяй, на те что у тебя. ну и вариант повторяющий VBA =(A1-LOOKUP(A1;{0;2;4;6;8;10}/1%%))*LOOKUP(A1;{0;20001;40001;60001;80001;100001};{12;15;20;25;30;35}%)+LOOKUP(A1;{0;20001;40001;60001;80001;100001};{0;24;54;94;144;204})*100 Естественно, не смотря на краткость первого варианта, он во много раз медленнее и чем больше сумма тем медленнее.
Скрытый текст
для 30000 и 70000 расчет приведен 100 итераций =SUMPRODUCT(LOOKUP(ROW(A$1:INDEX(A:A,A1)),{0;20001;40001;60001;80001;100001},{12;15;20;25;30;35}%)) 546.875 =(A1-LOOKUP(A1,{0;2;4;6;8;10}/1%%))*LOOKUP(A1,{0;20001;40001;60001;80001;100001},{12;15;20;25;30;35}%)+LOOKUP(A1,{0;20001;40001;60001;80001;100001},{0;24;54;94;144;204}*100) 3.90625 =SUMPRODUCT(LOOKUP(ROW(A$1:INDEX(A:A,A2)),{0;20001;40001;60001;80001;100001},{12;15;20;25;30;35}%)) 1285.156 =(A2-LOOKUP(A2,{0;2;4;6;8;10}/1%%))*LOOKUP(A2,{0;20001;40001;60001;80001;100001},{12;15;20;25;30;35}%)+LOOKUP(A2,{0;20001;40001;60001;80001;100001},{0;24;54;94;144;204}*100) 3.90625
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Sub testspeed() Application.Calculation = xlCalculationManual For Each cell In Selection t = Timer For i = 1 To 100 cell.Calculate Next Debug.Print cell.Formula, (Timer - t) * 1000 Next Application.Calculation = xlCalculationAutomatic End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
ну да, =IF(A1=20000;2400;(A1-LOOKUP(A1;{0;2;4;6;8;10}/1%%))*LOOKUP(A1;{0;20001;40001;60001;80001;100001};{12;15;20;25;30;35}%))+LOOKUP(A1;{0;20001;40001;60001;80001;100001};{0;24;54;94;144;204}*100) и на сей раз математика опережает алгоритмы и по скорости и по краткости.
Ну это типа - решение в лоб Да и вообще, если учитывать минимальный оклад - 12792 руб, то можно решать упрощенно. Хотя если гражданин проработал меньше года, то все равно нужно учитывать все условия. А вообще как происходить вычеты подоходного налога? Каждый месяц по минимальной ставке, а в конце года перерасчет? Кто-нибудь в курсе?
Михаил Л написал: А вообще как происходить вычеты подоходного налога? Каждый месяц по минимальной ставке, а в конце года перерасчет? Кто-нибудь в курсе?
где? Во времена прогрессивного ? каждый месяц считался для вычета сразу, помнится я забабахал итерационным алгоритмом, для расчета зарплаты при условии что фиксирована ставка нетто, но ему не поверили, хоть и считал корректно. А считалось в основном просто. Есть начисление до, есть текущее, есть выплаченный до, есть то что по текущим рассчитано, разница - подоходный в текущем месяце с учетом всех переходящих ставок. А за бугром вроде они отчитываются за период целиком. Заполнят декларацию и вычитают от туда все что можно вернуть..... Если интересно, то могу уточнить, друзья там.
переосмыслил алгоритм. скорость возросла , краткость увеличилась =MOD(A1;20000)*INDEX({12;15;20;25;30;35}%;MIN(A1/20000+1;6))+INDEX({0;24;54;94;144;204}*100;MIN(A1/20000+1;6))
Скрытый текст
=MOD(A1,20000)*INDEX({12;15;20;25;30;35}%,MIN(A1/20000+1,6))+INDEX({0;24;54;94;144;204}*100,MIN(A1/20000+1,6)) 349.6094 =IF(TRUNC(A1/20000)=0,A1*0.12,(MIN(5,TRUNC(A1/20000))+2)*0.05*(A1-MIN(5,TRUNC(A1/20000))*20000)+((MIN(5,TRUNC(A1/20000)))^2+3*(MIN(5,TRUNC(A1/20000))))*500+400) 345.7031 =IF(A1-20000,(MIN(5,TRUNC(A1/20000))+2)*0.05*(A1-MIN(5,TRUNC(A1/20000))*20000)+((MIN(5,TRUNC(A1/20000)))^2+3*(MIN(5,TRUNC(A1/20000))))*500+400,A1*0.12) 300.7813 Но по скорости выигрывает чуть модифицированный вариант тезки
Пошли дальше, а нафига все эти умножить разделить? =MOD(A1;20000)*INDEX({0,12;0,15;0,2;0,25;0,3;0,35};MIN(A1/20000+1;6))+INDEX({0;2400;5400;9400;14400;20400};MIN(A1/20000+1;6)) а что самое тяжкое - конечно сравнение, а его два , уберем , стало и короче и быстро, несмотря на то, что увеличилось количество математических операций. =INDEX(MOD(A1;20000)*{0,12;0,15;0,2;0,25;0,3;0,35}+{0;2400;5400;9400;14400;20400};MIN(A1/20000+1;6))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
ну как - получился отличный "гибрид" - таблица (все-таки в изначальном условии она есть), но не с поиском, а с прямым обращением к вычисленной позиции. Надо в PQ перенести - там тоже скорости сравнить
Соблюдение правил форума не освобождает от модераторского произвола
buchlotnik написал: блин, все ноги не доходят это в Мерку запихнуть...
Тезка я тут заметил, что при приблизительно равных результатах, первая обрабатываемая формула всегда показывает чуть худший результат. Посмотри у себя. Ок?
Ну а по поводу таблички "брадиса" :-) так тут все на честном слове и то что порог в 20000 ровно в отличи от других шкал. То есть под конкретную шкалу решения работают.
БМВ: при приблизительно равных результатах, первая обрабатываемая формула всегда показывает чуть худший результат
добавь паузу на секунду и/или несколько раз прогоняй по очереди (1е, 2е, 1е …) с получением среднего результата Чтобы такого не было, а также, чтобы не внедрять высокоточный таймер, как сокол предлагал, я использую объёмы для отрыва хотя бы в секунду — так можно не бояться того, что процессы компа внесут ошибки в замеры
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
БМВ написал: первая обрабатываемая формула всегда показывает чуть худший результат.
ага, и на запросах та же фигня - первый проверяемый пробуксовывает на первой итерации - в мыслях было первую попытку не засчитывать в итог, но до реализации пока не дополз
Цитата
Jack Famous написал: несколько раз прогоняй по очереди (1е, 2е, 1е …)
с запросами не прокатит - именно потому что пробуксовывает первая итерация первого а в чём глобальная причина? особенно про паузу интересно - чем она спасает?
Sub testspeed()
Application.Calculation = xlCalculationManual
For Each Cell In Selection
Application.Wait Now() + CDate("0:0:1")
t = Timer
For i = 1 To 10000
Cell.Calculate
Next
Debug.Print Cell.Formula, (Timer - t) * 1000
Next
Application.Calculation = xlCalculationAutomatic
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Я в миру ответил. ну на всякий случай =(B15-LOOKUP(-B15;-{99999;504;378;294;252;210;168;126;84;42}*10^6;{504;378;294;252;210;168;126;84;42;0}*10^6))*LOOKUP(-B15;-{99999;504;378;294;252;210;168;126;84;42}*10^6;{0,6;0,55;0,5;0,45;0,4;0,35;0,3;0,25;0,2;0}%)+LOOKUP(-B15;-{99999;504;378;294;252;210;168;126;84;42}*10^6;{1932;1239;819;630;462;315;189;84;0}*1000) и тоже, но короче =(B15-LOOKUP(-B15;-42*{10000;12;9;7;6;5;4;3;2;1}*10^6;{504;378;294;252;210;168;126;84;42;0}*10^6))*LOOKUP(-B15;-42*{10000;12;9;7;6;5;4;3;2;1}*10^6;{60;55;50;45;40;35;30;25;20;0}%%)+LOOKUP(-B15;-42*{10000;12;9;7;6;5;4;3;2;1}*10^6;{1932;1239;819;630;462;315;189;84;0}*1000) и еще короче =(B15-LOOKUP(INT(B15/42/10^6);{0;1;2;3;4;5;6;7;9;12})*42*10^6)*5*INDEX({0;4;5;6;7;8;9;10;11;11;12;12;12};MIN(INT(B15/42/10^6)+1;13))%%+LOOKUP(-B15;-42*{10000;12;9;7;6;5;4;3;2;1}*10^6;{1932;1239;819;630;462;315;189;84;0}*1000)