Пользовательские функции

И придут они среди человеков и покажут чудеса великие от земли и до края небес и соблазнятся в те времена умы многие и впадут в искушение.

Святое Писание

Апокалипсис

 

Если вы работали с Excel, значит вы работали с формулами. VBA позволяет не только эффективно использовать эти формулы в своих программах, но и самим создавать подобные творения.

Вы можете открыть уже готовый пример:    Пример

 

Для создания Пользовательской функции, необходимо создать пустой макрос (создать Модуль), куда дописать следующий тип программы Function:


Public Function Increase(Number)

Increase = Number * 1000 + 12

End Function


Подробнее:

Public Function (это команда VBA на создание функции) Increase (название функции которая будет вычислять) (Number) (название переменной, которая будет участвовать в вычислениях)

Increase = (мы говорим VBA, что функция с названием Increase будет вычисляться так: ) Number * 1000 + 12 (заданная ранее переменная Number умножится и прибавится: * 1000 + 12)

End Function (все расчёты завершены)

 

Необходимо вставить этот программный код в Модуль.

 

Теперь, мы выделяем ячейку и вставляем туда формулу Increase (работаем как с обычными формулами Excel) из раздела Определённые пользователем.

Далее проставляем заданные переменные:

И получаем результат, как при работе со стандартными формулами (разница лишь в скорости вычислений – у VBA скорость значительно меньше, но заметно это только при ёмких расчётах).

 

Стоит отдельно остановиться на функции SimpleSum:


Public Function SimpleSum(ParamArray list() As Variant) As Double

For Each cell In list

SimpleSum = SimpleSum + cell

Next cell

End Function


Public Function SimpleSum (название функции) (ParamArray list() (задаёт бесконечный запрос на переменные list) As Variant) As Double (операторы присвоения не рассматриваются в методичке)

For Each cell In list (мы говорим VBA, что для каждой ячейки в списке переменных list выполняется следующий расчёт:)

SimpleSum = SimpleSum + cell (функция SimpleSum = к каждому итогу SimpleSum прибавляется ячейка cell, которая как вы наверное помните, определяет каждую переменную в списке list, т.е. к итогу прибавляются новые переменные, пока они не кончатся.) И теперь попробуйте сказать, что программировать в VBA просто :)))

Next cell (мы завершаем поиск всех переменных cell)

End Function (все расчёты завершены)

 

В последнем примере функции SimpleSumInc, мы добавили постоянную переменную Constanta и умножаем каждую выбранную ячейку для суммы на эту переменную. Постарайтесь сами вникнуть в суть программы.

 

К сожалению, пользовательские функции будут работать только в файле, где они прописаны. Для новых файлов, их придётся переносить новым макросом.

Если необходимо постоянно пользоваться определённой функцией – её можно прописать в PERSONAL.XLS , но имейте в виду – работать она будет только на вашем компьютере.

 


Прилагаемая функция позволяет числовые финансовые значения писать русскими словами.

Пример: 144917-99 как Сто сорок четыре тысячи девятьсот семнадцать рублей девяносто девять копеек

Очень удобная вещичка:    Сумма прописью

 

 

Function СуммаПрописью(pNUM As Variant) As String

Dim vNUM As Double
Dim LETTERS, L, w As String
Dim L100(9) As String
Dim L10(9) As String
Dim L1(22) As String
Dim SYM(3, 4) As String
Dim DIG(4) As Integer
Dim NUMRUB, i, j, x, n100, n10, n1 As Integer


L100(0) = ""
L100(1) = "сто "
L100(2) = "двести "
L100(3) = "триста "
L100(4) = "четыреста "
L100(5) = "пятьсот "
L100(6) = "шестьсот "
L100(7) = "семьсот "
L100(8) = "восемьсот "
L100(9) = "девятьсот "

L10(0) = ""
L10(1) = ""
L10(2) = "двадцать "
L10(3) = "тридцать "
L10(4) = "сорок "
L10(5) = "пятьдесят "
L10(6) = "шестьдесят "
L10(7) = "семьдесят "
L10(8) = "восемьдесят "
L10(9) = "девяносто "

L1(0) = ""
L1(1) = "один "
L1(2) = "два "
L1(3) = "три "
L1(4) = "четыре "
L1(5) = "пять "
L1(6) = "шесть "
L1(7) = "семь "
L1(8) = "восемь "
L1(9) = "девять "
L1(10) = "десять "
L1(11) = "одиннадцать "
L1(12) = "двенадцать "
L1(13) = "тринадцать "
L1(14) = "четырнадцать "
L1(15) = "пятнадцать "
L1(16) = "шестнадцать "
L1(17) = "семнадцать "
L1(18) = "восемнадцать "
L1(19) = "девятнадцать "
L1(20) = "двадцать "
L1(21) = "одна "
L1(22) = "две "

SYM(1, 0) = "миллиард " 'для 01
SYM(1, 1) = "миллион "
SYM(1, 2) = "тысяча "
SYM(1, 3) = "рубль "
SYM(1, 4) = "копейка "

SYM(2, 0) = "миллиарда " 'для 02,03,04
SYM(2, 1) = "миллиона "
SYM(2, 2) = "тысячи "
SYM(2, 3) = "рубля "
SYM(2, 4) = "копейки "

SYM(3, 0) = "миллиардов " 'для всех остальных
SYM(3, 1) = "миллионов "
SYM(3, 2) = "тысяч "
SYM(3, 3) = "рублей "
SYM(3, 4) = "копеек "

If Val(pNUM) <= 0 Or Val(pNUM) > 1000000000000# Then
MsgBox ("Сумма должна быть больше нуля и меньше одного триллиона рублей!")
СуммаПрописью = "Ошибка оператора!"
Exit Function
End If

'Выделение копеек
j = Len(pNUM)
For i = 1 To j
w = Mid(pNUM, i, 1)
If (w = "-") Or (w = "=") Or (w = ",") Then w = "."
L = L + w
Next i

vNUM = Val(L)


DIG(4) = (vNUM - Fix(vNUM)) * 100
'Выделение руб, тыс, миллионов и миллиардов
For i = 3 To 0 Step -1
vNUM = Fix(vNUM) / 1000
DIG(i) = (vNUM - Fix(vNUM)) * 1000
Next i


'Заполнение символьного поля
For i = 0 To 4
n1 = 0
x = DIG(i)
n100 = Fix(x / 100)
n10 = x - n100 * 100
n1 = n10 - Fix(n10 / 10) * 10
LETTERS = LETTERS + L100(n100) 'сотни
If n10 <= 20 Then
If (i = 2 Or i = 4) And (n10 = 1 Or n10 = 2) Then n10 = n10 + 20 'Если тысяча или копейка то в женский род
LETTERS = LETTERS + L1(n10) 'единицы до 20
Else '>20
x = n10
n10 = Fix(n10 / 10)
n1 = x - n10 * 10
LETTERS = LETTERS + L10(n10)
If (i = 2 Or i = 4) And (n1 = 1 Or n1 = 2) Then
LETTERS = LETTERS + L1(n1 + 20) 'Если тысяча или копейка то в женский род
Else
LETTERS = LETTERS + L1(n1) 'единицы до 20
End If
End If
'заполнение наименований
If i = 4 Then
n1 = DIG(4) - Fix(DIG(4) / 10) * 10 'для копеек
End If
Select Case n1
Case 0
j = 0
Case 1
j = 1
Case 2
j = 2
Case 3
j = 2
Case 4
j = 2
Case Else
j = 3
End Select
If n10 - n1 = 10 Then j = 3
If (n10 > 0 Or n100 > 0) And j = 0 Then j = 3
LETTERS = LETTERS + SYM(j, i)

If i = 3 And DIG(3) = 0 Then LETTERS = LETTERS + "рублей "

Next i
'Первая буква - заглавная
LETTERS = Trim(Chr(Asc(Left(LETTERS, 1)) - 32) + Mid(LETTERS, 2))
СуммаПрописью = LETTERS


End Function


 

Назад    Главная    Далее