Всем привет, меня зовут Андрей, это снова я!
Продолжаю рассказывать про то, как можно составлять кроссворды с помощью Эксель.
Напомню, первую часть по этой теме можно найти по ссылке:
Итак, продолжаем. На следующем этапе можно разбить каждое слово на буквы следующим образом:
Если мы перед этим уже заполнили столбцы до G и H, то разбивка наших ранее добавленных слов в базу данных займет не так много времени. Всю эту разбивку можно осуществить с помощью всего одного макроса.
Но прежде, чем говорить про этот макрос, нужно создать в нашем основном файле еще один лист и присвоить ему имя / заголовок "Имена". Там мы время от времени будем помещать такие имена, которые нам реально пригодятся при работе по составлению или отгадыванию кроссвордов.
В любую пустую клетку этого листа введем формулу:
=""
Все достаточно просто. Знак равенства, а также две кавычки подряд. Это будет означать, что имеется ввиду совсем пустая ячейка, которая не может быть приравнена к нулю, не является числовой ячейкой, и не содержит ни одного символа. Просто пустота. Пустая текстовая (не числовая) ячейка.
Присвоим этой ячейке имя:
emp
Все буквы латинские.
Этой же ячейке присвоим еще одно имя:
пус
Иногда бывает удобно использовать имя, содержащее русские буквы, а иногда - имя с латиницей. В Эксель одной и той же ячейке (или одному и тому же блоку данных) можно одновременно присваивать несколько имен.
После того, как мы создали этот лист и ввели нужные нам имена, можно вернуться к тому листу. который содержит слова для кроссворда, и ввести нужный нам макрос, который будет разбивать слова на буквы.
Итак, вот сам текст макроса:
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
Cells(i, j) = 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
Этот макрос предварительно спрашивает номера строк: "верхней" и "нижней" строки. В нашем случае номер верхней строки - это цифра 2 (потому что в строке 1 Эксель только заголовки, первое слово начинается со строки 2 Эксель), а номер нижней строки зависит только от того, на какой именно строке расположено наше самое "нижнее" слово. У меня к моменту написания этой статьи в базе чуть больше, чем 2000 слов, но если у кого-то есть в базе другое число слов, то нужно в качестве второй цифры ввести именно номер самой нижней строки.
В любое время можно продолжить работу над нашим файлом, вначале вводя слова целиком, а затем разбивая слова с помощью макроса.
Продолжение следует...
