77 lines
3.5 KiB
Markdown
77 lines
3.5 KiB
Markdown
|
||
## Идеи расширения для Excel
|
||
1. Поиск русских букв в латинице и наоборот
|
||
2. Кнопка переключения стиля сслык R1C1 на А1 и обратно
|
||
3. Объединение ячеек без потери текста и разъединение обратно
|
||
4. автоматическая установка расширения при открытии
|
||
Отображение скрытых строк
|
||
Иногда большие файлы Excel можно содержать скрытые строки для большей ясности И для лучшего удобства пользователей. Вот один макрос, который отобразит все строки из активной рабочей таблицы:
|
||
|
||
Sub ShowHiddenRows()
|
||
Columns.EntireColumn.Hidden = False
|
||
Rows.EntireRow.Hidden = False
|
||
End Sub
|
||
|
||
Удаление пустых строк и столбов
|
||
Пустые строки в Excel - может быть проблемой для обработки данных. Вот как избавиться от них:
|
||
|
||
Sub DeleteEmptyRowsAndColumns()
|
||
'Declare your variables.
|
||
Dim MyRange As Range
|
||
Dim iCounter As Long
|
||
'Define the target Range.
|
||
Set MyRange = ActiveSheet.UsedRange
|
||
'Start reverse looping through the range of Rows.
|
||
For iCounter = MyRange.Rows.Count To 1 Step -1
|
||
'If entire row is empty then delete it.
|
||
If Application.CountA(Rows(iCounter).EntireRow) = 0 Then
|
||
Rows(iCounter).Delete
|
||
'Remove comment to See which are the empty rows
|
||
'MsgBox "row " & iCounter & " is empty"
|
||
End If
|
||
'Increment the counter down
|
||
Next iCounter
|
||
'Step 6: Start reverse looping through the range of Columns.
|
||
For iCounter = MyRange.Columns.Count To 1 Step -1
|
||
'Step 7: If entire column is empty then delete it.
|
||
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
|
||
Columns(iCounter).Delete
|
||
End If
|
||
'Step 8: Increment the counter down
|
||
Next iCounter
|
||
End Sub
|
||
|
||
транслитерация текста
|
||
Function Translit(Txt As String) As String
|
||
|
||
Dim Rus As Variant
|
||
Rus = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", _
|
||
"л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", _
|
||
"щ", "ъ", "ы", "ь", "э", "ю", "я", "А", "Б", "В", "Г", "Д", "Е", _
|
||
"Ё", "Ж", "З", "И", "Й", "К", "Л", "М", "Н", "О", "П", "Р", _
|
||
"С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", "Щ", "Ъ", "Ы", "Ь", "Э", "Ю", "Я")
|
||
|
||
Dim Eng As Variant
|
||
Eng = Array("a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "j", _
|
||
"k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "ch", _
|
||
"sh", "sch", "''", "y", "'", "e", "yu", "ya", "A", "B", "V", "G", "D", _
|
||
"E", "JO", "ZH", "Z", "I", "J", "K", "L", "M", "N", "O", "P", "R", _
|
||
"S", "T", "U", "F", "KH", "TS", "CH", "SH", "SCH", "''", "Y", "'", "E", "YU", "YA")
|
||
|
||
For I = 1 To Len(Txt)
|
||
с = Mid(Txt, I, 1)
|
||
|
||
flag = 0
|
||
For J = 0 To 65
|
||
If Rus(J) = с Then
|
||
outchr = Eng(J)
|
||
flag = 1
|
||
Exit For
|
||
End If
|
||
Next J
|
||
If flag Then outstr = outstr & outchr Else outstr = outstr & с
|
||
Next I
|
||
|
||
Translit = outstr
|
||
|
||
End Function |