отформатировать часть текста в ячейке

[eto]

Помогите, пожалуйста, написать макрос.
Задача такова - проверить все ячейки на листе и в непустых выделить жирным, цветом, увеличить размер шрифта текста, находящегося на третьей строке в этой ячейке.

[EducatedFool]

Sub Форматирование()
    Dim ra As Range, cell As Range: Application.ScreenUpdating = False
    Set ra = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    For Each cell In ra.Cells
        arr = Split(cell.Value, Chr(10))
        If UBound(arr) >= 3 Then
            pos = Len(arr(0)) + Len(arr(1)) + 3: lenght = Len(arr(2))
            With cell.Characters(pos, lenght)
                .Font.Color = vbBlue: .Font.Bold = True: .Font.Size = 10
            End With
        End If
    Next cell
End Sub


Sub ОчисткаФорматирования()
    Dim ra As Range: Set ra = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    ra.Font.Color = vbBlack: ra.Font.Bold = False: ra.Font.Size = 8
End Sub

[eto]

спасибо большое, работает почти как надо
в примере не учла, что есть ячейки, где всего три строки - в таком случае третья сейчас не выделяется, подскажите, плиз, что именно нужно поменять в коде, чтобы заработало?

[EducatedFool]

что именно нужно поменять в коде, чтобы заработало?

В строке If UBound(arr) >= 3 Then замените 3 на 2

[eto]

отлично, еще раз спасибо!

помимо того, что это работает, хотелось бы разобраться - как
в частности - что вот тут происходит:

pos = Len(arr(0)) + Len(arr(1)) + 3: lenght = Len(arr(2))

и как, например, сделать чтобы ещё и первая строка выделялась?
на будущее, в качестве общего развития :)

[EducatedFool]

Sub Форматирование()
    Dim ra As Range, cell As Range: Application.ScreenUpdating = False
    Set ra = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    ' диапазон ra - все заполненные ячейки активного листа

    For Each cell In ra.Cells
        ' разбиваем текст в строке за отдельные строки (разделителем является символ Chr(10))
        arr = Split(cell.Value, Chr(10))    ' получаем массив, количество элементов в котором равно числу строк в ячейке
        ' каждый элемент массива arr - текст очередной строки

        If UBound(arr) >= 2 Then    ' UBound(arr) - верхняя граница полученного массива
            ' эта граница на 1 меньше, чем количество элементов в нём (строк в ячейке)
            ' (поскольку элементы в массиве нумеруются с нуля)

            ' Обрабатывать текст ячейки будем только в том случае, если UBound(arr) >= 2
            ' т.е. если количество строк в ячейке не меньше трёх

            ' вычисляем позицию первого символа для форматирования:
            pos = Len(arr(0)) + Len(arr(1)) + 3            ' длина первой строки + длина второй строки
            ' + 2 символа перевода строки + 1

            lenght = Len(arr(2))    ' длина третьей строки

            With cell.Characters(pos, lenght)    ' в качестве параметров указываем pos - позицию
                ' первого обрабатываемого символа, и lenght - количество символов для обработки

                .Font.Color = vbBlue: .Font.Bold = True: .Font.Size = 10    ' собственно, само форматирование
            End With

            ' а теперь покрасим первую строку в ячейке:
            With cell.Characters(1, Len(arr(0)))    ' в качестве параметров указываем 1 - позицию
                ' первого обрабатываемого символа, и Len(arr(0)) - количество символов в первой строке

                .Font.Color = vbRed: .Font.Bold = True: .Font.Size = 12    ' собственно, само форматирование
            End With
        End If
    Next cell
End Sub

[eto]

и снова спасибо, особенно за развернутое пояснение ^_^b

[iPAVELS]

Сообщение от EducatedFool

Sub Форматирование()
    Dim ra As Range, cell As Range: Application.ScreenUpdating = False
    Set ra = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    ' диапазон ra - все заполненные ячейки активного листа

    For Each cell In ra.Cells
        ' разбиваем текст в строке за отдельные строки (разделителем является символ Chr(10))
        arr = Split(cell.Value, Chr(10))    ' получаем массив, количество элементов в котором равно числу строк в ячейке
        ' каждый элемент массива arr - текст очередной строки

        If UBound(arr) >= 2 Then    ' UBound(arr) - верхняя граница полученного массива
            ' эта граница на 1 меньше, чем количество элементов в нём (строк в ячейке)
            ' (поскольку элементы в массиве нумеруются с нуля)

            ' Обрабатывать текст ячейки будем только в том случае, если UBound(arr) >= 2
            ' т.е. если количество строк в ячейке не меньше трёх

            ' вычисляем позицию первого символа для форматирования:
            pos = Len(arr(0)) + Len(arr(1)) + 3            ' длина первой строки + длина второй строки
            ' + 2 символа перевода строки + 1

            lenght = Len(arr(2))    ' длина третьей строки

            With cell.Characters(pos, lenght)    ' в качестве параметров указываем pos - позицию
                ' первого обрабатываемого символа, и lenght - количество символов для обработки

                .Font.Color = vbBlue: .Font.Bold = True: .Font.Size = 10    ' собственно, само форматирование
            End With

            ' а теперь покрасим первую строку в ячейке:
            With cell.Characters(1, Len(arr(0)))    ' в качестве параметров указываем 1 - позицию
                ' первого обрабатываемого символа, и Len(arr(0)) - количество символов в первой строке

                .Font.Color = vbRed: .Font.Bold = True: .Font.Size = 12    ' собственно, само форматирование
            End With
        End If
    Next cell
End Sub

Все доступно-понятно. Но что делать, если ячейка сборная:

В3=F3 & СИМВОЛ(10) &
G3 & СИМВОЛ(10) &
M3 & СИМВОЛ(10) &
K3

а нужно применить форматирование по вкусу, к примеру:
1 строка - шрифт жирный и размер 14; 2 строка - шрифт золотой и размер 16; 3 строка - шрифт синий подчеркнутый.



PS В идеале бы макросу фул-набор действий:
1. Вставить 2 новых столбца на место B и С в активном листе.
2. Выбрать столбцы для импорта и сцепки в столбик B по наименованию столбцов - универсальным переменным (Name, Rate, Web, Tel) и выполнить копирование данных 4 строками в ячейку столбика B.
3. Применить задуманное форматирование к столбику B.
сведя мои действия к перезаглавию 4 столбиков и запуску макроса.

[kuklp]

Это уже кросс:
http://www.planetaexcel.ru/forum/ind...soderzhashchey

[iPAVELS]

Спасибо всем. Решение найдено (по кроссу выше). Без этой семилетней темы, я бы не поверил в близость решения, без варианта макроса EducatedFool не чем было даже тестировать свой файл.
Интернет - сила, форумы - мощь!