Excel Hacker

Макрос. Оглавление листов в Excel

2021-02-17T17:34:50.917Z

Sub Оглавление() 'This macro adds the TOC as first sheet in the workbook 'with name as "Оглавление" Dim sheetNum As Long

'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

Генерируем случайные текстовые числовые значения в EXCEL

2021-02-03T12:56:37.760Z

В ячейке А1 введем текстовую строку, из которой в случайном порядке будут выбираться символы: ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789

Запишем в ячейке, где нужно сгенерировать случайные значения, вставляем длинную формулу состоящую из 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)

МАКРОС ДЛЯ ПЕРЕВОД СУММЫ ИЛИ ЧИСЛА ПРОПИСЬЮ В EXCEL

2021-02-01T01:08:39.554Z

https://vm.tiktok.com/ZSEHeHg6/

Откройте редактор 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)

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)

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

Макрос для сортировки листов в Excel

2021-01-31T20:41:50.218Z

https://vm.tiktok.com/ZSEu4qhL/

Откройте редактор 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) он быстро отсортирует все листы в текущей книге по возрастанию.