'Removing previous TOC if any
On Error Resume Next
Sheets("Оглавление").Delete
On Error GoTo 0

'Adding a new TOC
ThisWorkbook.Sheets.Add _
Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "Оглавление"

For sheetNum = 1 To Sheets.Count
ActiveSheet.Cells(sheetNum, 1).Select
ActiveSheet.Hyperlinks.Add _
Anchor:=ActiveSheet.Cells(sheetNum, 1), _
Address:="", _
SubAddress:="'" & Sheets(sheetNum).Name & "'!A1", _
TextToDisplay:=Sheets(sheetNum).Name
Next sheetNum
End Sub

Запишем в ячейке, где нужно сгенерировать случайные значения, вставляем длинную формулу состоящую из 4 одинаковых частей: =ПСТР($A$1;СЛУЧМЕЖДУ(1;ДЛСТР($A$1));1) & ПСТР($A$1;СЛУЧМЕЖДУ(1;ДЛСТР($A$1));1) & ПСТР($A$1;СЛУЧМЕЖДУ(1;ДЛСТР($A$1));1) & ПСТР($A$1;СЛУЧМЕЖДУ(1;ДЛСТР($A$1));1)

Для того, чтобы сгенерировать больше случайных значений, нужно добавить еще соответствующее количество раз эту часть формулы:

& ПСТР($A$1;СЛУЧМЕЖДУ(1;ДЛСТР($A$1));1)

Откройте редактор Visual Basic с помощью сочетания клавиш ALT+F11, вставьте новый модуль (меню Insert - Module) и скопируйте туда код ЭТОГО МАКРОС. ЕГО КОПИРУЕМ И АККУРАТНО ВСТАВЛЯЕМ В ЯЧЕЙКУ КАК НА ВИДЕО:

После этот макрос можно запустить, написав формулу в любой ячейке

=ЧислоПрописьюВалюта(ячейка;тип_валюты)

Например, =ЧислоПрописьюВалюта(А2;1)

типы валюты бывают такие
1-рубли;
2-доллары;
0-евро

САМ МАКРОС

Function ЧислоПрописьюВалюта(Число As Double, Optional Валюта As Integer = 1, Optional Копейки As Integer = 1)

Dim Edinicy(0 To 19) As String: Dim EdinicyPoslednie(0 To 19) As String

Dim Desyatki(0 To 9) As String: Dim Sotni(0 To 9) As String: Dim mlrd(0 To 9) As String

Dim mln(0 To 9) As String: Dim tys(0 To 9) As String

Dim SumInt, x, shag, vl As Integer: Dim txt, Sclon_Tys As String

'---------------------------------------------

Application.Volatile

'---------------------------------------------

Edinicy(0) = "": EdinicyPoslednie(0) = IIf(Валюта = 0, "евро", IIf(Валюта = 1, "рублей", "долларов"))

Edinicy(1) = "один ": EdinicyPoslednie(1) = IIf(Валюта = 0, "один евро", IIf(Валюта = 1, "один рубль", "один доллар"))

Edinicy(2) = "два ": EdinicyPoslednie(2) = IIf(Валюта = 0, "два евро", IIf(Валюта = 1, "два рубля", "два доллара"))

Edinicy(3) = "три ": EdinicyPoslednie(3) = IIf(Валюта = 0, "три евро", IIf(Валюта = 1, "три рубля", "три доллара"))

Edinicy(4) = "четыре ": EdinicyPoslednie(4) = IIf(Валюта = 0, "четыре евро", IIf(Валюта = 1, "четыре рубля", "четыре доллара"))

Edinicy(5) = "пять ": EdinicyPoslednie(5) = IIf(Валюта = 0, "пять евро", IIf(Валюта = 1, "пять рублей", "пять долларов"))

Edinicy(6) = "шесть ": EdinicyPoslednie(6) = IIf(Валюта = 0, "шесть евро", IIf(Валюта = 1, "шесть рублей", "шесть долларов"))

Edinicy(7) = "семь ": EdinicyPoslednie(7) = IIf(Валюта = 0, "семь евро", IIf(Валюта = 1, "семь рублей", "семь долларов"))

Edinicy(8) = "восемь ": EdinicyPoslednie(8) = IIf(Валюта = 0, "восемь евро", IIf(Валюта = 1, "восемь рублей", "восемь долларов"))

Edinicy(9) = "девять ": EdinicyPoslednie(9) = IIf(Валюта = 0, "девять евро", IIf(Валюта = 1, "девять рублей", "девять долларов"))

Edinicy(11) = "одиннадцать ": EdinicyPoslednie(11) = IIf(Валюта = 0, "одиннадцать евро", IIf(Валюта = 1, "одиннадцать рублей", "одиннадцать долларов"))

Edinicy(12) = "надцать ": EdinicyPoslednie(12) = IIf(Валюта = 0, "надцать евро", IIf(Валюта = 1, "надцать рублей", "надцать долларов"))

Edinicy(13) = "тринадцать ": EdinicyPoslednie(13) = IIf(Валюта = 0, "тринадцать евро", IIf(Валюта = 1, "тринадцать рублей", "тринадцать долларов"))

Edinicy(14) = "четырнадцать ": EdinicyPoslednie(14) = IIf(Валюта = 0, "четырнадцать евро", IIf(Валюта = 1, "четырнадцать рублей", "четырнадцать долларов"))

Edinicy(15) = "пятнадцать ": EdinicyPoslednie(15) = IIf(Валюта = 0, "пятнадцать евро", IIf(Валюта = 1, "пятнадцать рублей", "пятнадцать долларов"))

Edinicy(16) = "шестнадцать ": EdinicyPoslednie(16) = IIf(Валюта = 0, "шестнадцать евро", IIf(Валюта = 1, "шестнадцать рублей", "шестнадцать долларов"))

Edinicy(17) = "семнадцать ": EdinicyPoslednie(17) = IIf(Валюта = 0, "семнадцать евро", IIf(Валюта = 1, "семнадцать рублей", "семнадцать долларов"))

Edinicy(18) = "восемнадцать ": EdinicyPoslednie(18) = IIf(Валюта = 0, "восемнадцать евро", IIf(Валюта = 1, "восемнадцать рублей", "восемнадцать долларов"))

Edinicy(19) = "девятнадцать ": EdinicyPoslednie(19) = IIf(Валюта = 0, "девятнадцать евро", IIf(Валюта = 1, "девятнадцать рублей", "девятнадцать долларов"))

''---------------------------------------------

Desyatki(0) = "": Sotni(0) = "": tys(0) = "тисячь ": mln(0) = "миллионов ": mlrd(0) = "миллиардов "

Desyatki(1) = "десять ": Sotni(1) = "сто ": tys(1) = "тысяча ": mln(1) = "миллион ": mlrd(1) = "миллиарда "

Desyatki(2) = "двадцать ": Sotni(2) = "двести ": tys(2) = "тысячи ": mln(2) = "миллиона ": mlrd(2) = "миллиарда "

Desyatki(3) = "тридцать ": Sotni(3) = "триста ": tys(3) = "тысячи ": mln(3) = "миллиона ": mlrd(3) = "миллиарда "

Desyatki(4) = "сорок ": Sotni(4) = "четыреста ": tys(4) = "тысячи ": mln(4) = "миллиона ": mlrd(4) = "миллиарда "

Desyatki(5) = "пятьдесят ": Sotni(5) = "пятьсот ": tys(5) = "тысяч ": mln(5) = "миллионов ": mlrd(5) = "миллиардов "

Desyatki(6) = "шестьдесят ": Sotni(6) = "шестьсот ": tys(6) = "тысяч ": mln(6) = "миллионов ": mlrd(6) = "миллиардов "

Desyatki(7) = "семьдесят ": Sotni(7) = "семьсот ": tys(7) = "тысяч ": mln(7) = "миллионов ": mlrd(7) = "миллиардов "

Desyatki(8) = "восемьдесят ": Sotni(8) = "восемьсот ": tys(8) = "тысяч ": mln(8) = "миллионов ": mlrd(8) = "миллиардов "

Desyatki(9) = "девяносто ": Sotni(9) = "девятьсот ": tys(9) = "тысяч ": mln(9) = "миллионов ": mlrd(9) = "миллиардов "

'---------------------------------------------

On Error Resume Next

SumInt = Int(Число)

For x = Len(SumInt) To 1 Step -1

shag = shag + 1

Select Case x

Case 12 ' - сотни миллиардов

vl = Mid(SumInt, shag, 1)

txt = txt & Sotni(vl)

Case 11 ' - десятки миллиардов

vl = Mid(SumInt, shag, 1)

If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки

Case 10 ' - единицы миллиардов

vl = Mid(SumInt, shag, 1)

If shag > 1 Then

If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "миллиарда " Else txt = txt & Edinicy(vl) & mlrd(vl) 'числа в диапозоне от 11 до 19 склоняются на "мільярдов" независимо от последнего числа триады

Else

txt = txt & Edinicy(vl) & mlrd(vl)

End If

'-КОНЕЦ БЛОКА_______________________

Case 9 ' - сотни миллионов

vl = Mid(SumInt, shag, 1)

txt = txt & Sotni(vl)

Case 8 ' - десятки миллионов

vl = Mid(SumInt, shag, 1)

If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки

Case 7 ' - единицы миллионов

vl = Mid(SumInt, shag, 1)

If shag > 2 Then

If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo 10

End If

If shag > 1 Then

If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "миллиона " Else: txt = txt & Edinicy(vl) & mln(vl) 'числа в диапозоне от 11 до 19 склоняются на "миллиардов" независимо от последнего числа триады

Else

txt = txt & Edinicy(vl) & mln(vl)

End If

'-КОНЕЦ БЛОКА_______________________

Case 6 ' - сотни тысяч

vl = Mid(SumInt, shag, 1)

txt = txt & Sotni(vl)

Case 5 ' - десятки тысяч

vl = Mid(SumInt, shag, 1)

If vl = 1 And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки

Case 4 ' - единицы тысяч

vl = Mid(SumInt, shag, 1)

If shag > 2 Then

If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo 10

End If

Sclon_Tys = Edinicy(vl) & tys(vl) ' - вводим переменную Sclon_Tys из-за иного склонения тысяч в русском языке

If vl = 1 Then Sclon_Tys = "одна " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную Sclon_Tys )

If vl = 2 Then Sclon_Tys = "две " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную Sclon_Tys )

If shag > 1 Then

If Mid(SumInt, shag - 1, 1) = 1 Then Sclon_Tys = Edinicy(Mid(SumInt, shag - 1, 2)) & "тисяч "

End If

txt = txt & Sclon_Tys

'-КОНЕЦ БЛОКА_______________________

Case 3 ' - сотни

vl = Mid(SumInt, shag, 1)

txt = txt & Sotni(vl)

Case 2 ' - десятки

vl = Mid(SumInt, shag, 1)

If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки

Case 1 ' - единицы

If Mid(SumInt, shag - 1, 1) <> 1 Or Mid(SumInt, shag - 1, 2) = "10" Then vl = Mid(SumInt, shag, 1) Else vl = Mid(SumInt, shag - 1, 2)

txt = txt & EdinicyPoslednie(vl)

'-КОНЕЦ БЛОКА_______________________

End Select

10: Next x

a = Число

b = Int(a)

c = (Round(a - b, 2)) * 100

If c < 10 And c >= 1 Then c = "0" + CStr(c)

If c = 0 Then c = CStr(c) + "0"

d = ""

If Валюта = 1 Then d = "коп." Else d = "цен."

If Валюта > 2 Or Валюта < 0 Then MsgBox "Укажите параметр 0-2"

If Валюта > 2 Or Валюта < 0 Then GoTo 11

If Копейки = 0 Then

d = ""

c = ""

End If

If Копейки = 2 Then d = ""

If Копейки > 2 Or Копейи < 0 Then MsgBox "Укажите параметр 0, 1 или 2"

If Копейки > 2 Or Копейки < 0 Then GoTo 11

ЧислоПрописьюВалюта = UCase(Left(txt, 1)) & LCase(Mid(txt, 2)) + " " + CStr(c) + d

11:

End Function

Sub DescribeFunction()

Dim FuncName As String

Dim FuncDesc As String

Dim Category As String

Dim ArgDesc(1 To 3) As String

FuncName = "ЧислоПрописьюВалюта"

FuncDesc = "Функция преобразовывает число суммы текстовыми словами"

Category = 1 'Text category

ArgDesc(1) = "Исходная сумма"

ArgDesc(2) = "(необязательный) Тип отображаемой валюты 0-Евро, 1-Рубли, 2-Доллары."

ArgDesc(3) = "(необязательный) Нужны ли копейки: 0-нет, 1-отображать копейи стандартно, 2-отображать только дробную часть (без слов)."

Application.MacroOptions _

Macro:=FuncName, _

Description:=FuncDesc, _

Category:=Category, _

ArgumentDescriptions:=ArgDesc

End Sub

Откройте редактор Visual Basic с помощью сочетания клавиш ALT+F11, вставьте новый модуль (меню Insert - Module) и скопируйте туда код этого макроса:

Sub SortSheets()

Dim I As Integer, J As Integer

For I = 1 To Sheets.Count - 1

For J = I + 1 To Sheets.Count

If UCase(Sheets(I).Name) > UCase(Sheets(J).Name) Then

Sheets(J).Move Before:=Sheets(I)

End If

Next J

Next I

End Sub

Теперь этот макрос можно запустить, нажав сочетание клавиш ALT+F8 и выбрав команду Выполнить (Run) он быстро отсортирует все листы в текущей книге по возрастанию.