Готовые макросы в VBA Excel, Миронов. Готовые макросы в vba excel, Миронов Глава Макросы 9

• Название: Готовые макросы в vba excel, Миронов Глава Макросы 9
• Дата: 23.01.2019
• Размер: 1.35 Mb.
• Имя файла: Готовые макросы в VBA Excel, Миронов.doc
• Тип: Документы; #64865
• страница: 22 из 47

Начисление процентов в зависимости от суммы_2

Function dhCalculatePercent(lngSum As Long) As Double

' Процентные ставки (декларация констант)

Const dblRate1 As Double = 0.09

Const dblRate2 As Double = 0.11

Const dblRate3 As Double = 0.15

' Граничные суммы вкладов (декларация констант)

Const intSum1 As Long = 5000

Const intSum2 As Long = 10000

' Возвращаем сумму, умноженную на соответствующую ставку

Select Case lngSum

Case Is < intSum1

dhCalculatePercent = lngSum * dblRate1

Case Is < intSum2

dhCalculatePercent = lngSum * dblRate2

Case Else

dhCalculatePercent = lngSum * dblRate3

End Select

End Function

Начисление процентов в зависимости от суммы_3

Function dhCalculatePercent(Sales As Long, IsTemporal As Boolean) As Double

' Процентные ставки (декларация констант)

Const dblRate1 As Double = 0.09

Const dblRate2 As Double = 0.11

Const dblRate3 As Double = 0.15

Const dblAdd As Double = 1.1

' Граничные суммы

Const lngSum1 As Long = 5000

Const lngSum2 As Long = 10000

' Расчет суммы для выплаты (как обычно)

If Sales < lngSum1 Then

dhCalculatePercent = Sales * dblRate1

ElseIf Sales < lngSum2 Then

dhCalculatePercent = Sales * dblRate2

Else

dhCalculatePercent = Sales * dblRate3

End If

If IsTemporal Then

' Для сторонних вкладчиков - надбавка

dhCalculatePercent = dblAdd * dhCalculatePercent

End If

End Function

Сводный пример расчета комиссионного вознаграждения

Function dhCalculateCom(dblSales As Double) As Double

Const dblRate1 = 0.09

Const dblRate2 = 0.11

Const dblRate3 = 0.15

' Расчет комиссионных с продаж (без выслуги) в зависимости _

от суммы

Select Case dblSales

Case 0 To 4999.99: dhCalculateCom = dblSales * dblRate1

Case 5000 To 9999.99: dhCalculateCom = dblSales * dblRate2

Case Is >= 10000: dhCalculateCom = dblSales * dblRate3

End Select

End Function

Function dhCalculateCom2(dblSales As Double, intYears As Double) _

As Double

Const dblRate1 = 0.09

Const dblRate2 = 0.11

Const dblRate3 = 0.15

' Расчет комиссионных с продаж (без учета выслуги лет) _

в зависимости от суммы

Select Case dblSales

Case 0 To 4999.99: dhCalculateCom2 = dblSales * dblRate1

Case 5000 To 9999.99: dhCalculateCom2 = dblSales * dblRate2

Case Is >= 10000: dhCalculateCom2 = dblSales * dblRate3

End Select

' Надбавка за выслугу лет

dhCalculateCom2 = dhCalculateCom2 + _

(dhCalculateCom2 * intYears / 100)

End Function

Sub ComCalculator()

Dim strMessage As String

Dim dblSales As Double

Dim ан As Integer

Calc:

' Отображение окна для ввода данных

dblSales = Val(InputBox("Сумма реализации:", _

"Расчет комиссионного вознаграждения"))

' Формирование сообщения (с одновременным расчетом _

вознаграждения)

strMessage = "Объем продаж:" & vbTab & Format(dblSales, "$#,##0") & _

vbCrLf & "Сумма вознаграждения:" & vbTab & _

Format(dhCalculateCom(dblSales), "$#,##0") & _

vbCrLf & vbCrLf & "Считаем дальше?"

' Вывод окна с сообщением (о рассчитанной сумме и вопросом _

о продолжении расчетов)

If MsgBox(strMessage, vbYesNo, _

"Расчет комиссионного вознаграждения") = vbYes Then

' Продолжение расчетов

GoTo Calc

End If

End Sub

Движение по диапазону

Sub FullShach()

For Each c In Range(addressdiap)

If c.Value > yr1 Then

c.Select

With Selection.Interior

.ColorIndex = 6

.Pattern = xlSolid

End With

Selection.Font.ColorIndex = yrcolor1

If c.Value > yr2 Then

c.Select

Selection.Font.ColorIndex = yrcolor2

If c.Value > yr3 Then

c.Select

Selection.Font.ColorIndex = yrcolor3

End If

End If

End If

Next c

End Sub