Всем привет, меня зовут Андрей, это снова я!
Часто бывает так, что нужно разбивать слова на буквы не совсем стандартным образом. Часто бывает необходимость в том, чтобы выравнивание разбитых слов шло не по первым буквам, а по последним.
Вот что должно получиться при такой разбивке слов на буквы:
Для такой разбивки нужно немного изменить тот макрос, который раньше производил разбивку с сортировкой по левому краю (по первым буквам).
Вот измененный текст макроса:
Sub Разбить_слова_на_буквы()
'отключаем обновление экрана
Application.ScreenUpdating = False
'Отключаем автоматический пересчет формул
Application.Calculation = xlCalculationManual
'Отключаем отслеживание событий
Application.EnableEvents = False
'Отключаем разбиение на печатные страницы
ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False
q1 = 1 * InputBox("Введите номер первой строки")
q2 = 1 * InputBox("Введите номер последней строки")
emp_ = ThisWorkbook.Names("emp").RefersToRange.Value
For i = q1 To q2
For j = 9 To 48
If Cells(i, 8) >= j - 8 Then
t = Cells(i, 8)
k = 40 - Cells(i, 8)
Cells(i, j) = Mid(Cells(i, 7), j - 8, 1)
Cells(i, j + t + 2 * k) = Mid(Cells(i, 7), j - 8, 1)
Else
Cells(i, j) = emp_
End If
Next j
Next i
'Возвращаем обновление экрана
Application.ScreenUpdating = True
'Возвращаем автоматический пересчет формул
Application.Calculation = xlCalculationAutomatic
'Включаем отслеживание событий
Application.EnableEvents = True
End Sub
- После выполнения этого макроса у нас появится разбивка слов с сортировкой и по первым буквам, и по последним.
