Здравствуйте. Нужна помощь с макросом по удалению текста в ячейке. Если в ячейке более двух строк, то нужно оставить первые две (верхние).
Было:
Сусальным золотом горят
В лесах рождественские елки;
В кустах игрушечные волки
Глазами страшными глядят.
Надо:
Сусальным золотом горят
В лесах рождественские елки;
[вложение удалено администратором]
Макрос
Sub Макрос()
Dim shRes As Worksheet, arr()
Dim spl, lr As Long, i As Long
'1. Vba-именование листа, с которым надо работать.
Set shRes = ActiveSheet
'2. Проверка, что нет скрытых строк, чтобы не было непредвиденных ситуаций.
If shRes.Columns("A").SpecialCells(xlCellTypeVisible).Rows.Count <> shRes.Columns("A").Rows.Count Then
MsgBox "Отобразите скрытые строки.", vbExclamation
Exit Sub
End If
'3. Копирование столбца B в массив, чтобы ускорить работу макроса: с массивом макрос быстрее работает.
lr = shRes.Cells(shRes.Rows.Count, "B").End(xlUp).Row
If lr = 1 Then
ReDim arr(1 To 1, 1 To 1)
arr(1, 1) = shRes.Range("B1").Value
Else
arr() = shRes.Range("B1:B" & lr).Value
End If
'4. Удаление текста после второго символа Chr(10) - он используется, чтобы переносить текст в ячейке
' на следующую строку.
For i = 1 To UBound(arr, 1)
' Разбивка текста в ячейке на три части по символу Chr(10).
spl = Split(arr(i, 1), Chr(10), 3)
' Если есть три части.
' У массива после Spit порядковый номер первого элемента ноль.
If UBound(spl) = 2 Then
' Оставление только первых двух элементов.
arr(i, 1) = spl(0) & Chr(10) & spl(1)
End If
Next i
'5. Вставка изменённых данных обратно в эксель.
shRes.Range("B1:B" & UBound(arr, 1)).Value = arr()
'6. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Огромная благодарность. Всегда завидую умным людям.