Макрос удаления пустых строк после текста.

[drongo777]

Добрый день. Нужно убрать пустые строки (с пробелами и переносами) в ячейках после текста. Как это осуществить с помощью макроса?

[Serge_Bliznykov]

если выложить файл с примером таких строк - то помощь может прийти быстрее.

[drongo777]

Прикладываю файл примера. Количество пустых после текста разное.

[Serge_Bliznykov]

вручную можно.

отсюда - http://office-guru.ru/excel/kak-udal...-2007-437.html

Удаляем возвраты каретки вручную
Плюсы: Этот способ самый быстрый.

Минусы: Никаких дополнительных плюшек

Вот так можно удалить переносы строк при помощи инструмента «Найти и заменить»:

Выделите все ячейки, в которых требуется удалить возвраты каретки или заменить их другим символом.
Нажмите Ctrl+H, чтобы вызвать диалоговое окно Найти и заменить (Find and Replace).


Поставьте курсор в поле Найти (Find what) и нажмите Ctrl+J. На первый взгляд поле покажется пустым, но если посмотрите внимательно, то увидите в нём маленькую точку.
В поле Заменить на (Replace With) введите любое значение для вставки вместо возвратов каретки. Обычно для этого используют пробел, чтобы избежать случайного склеивания двух соседних слов. Если нужно просто удалить переносы строк, оставьте поле Заменить на (Replace With) пустым.
Нажмите кнопку Заменить все (Replace All) и наслаждайтесь результатом!

[drongo777]

Этот метод, к сожалению, не подходит, т.к. у текста тоже уберутся переносы. Мне же нужно, чтобы после текста убрались пустые строчки с переносами.

[Serge_Bliznykov]

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

Этот метод, к сожалению, не подходит, т.к. у текста тоже уберутся переносы.

ок.

а если такой макрос:

Sub TrimAll()
Dim C As Range
For Each C In ActiveSheet.UsedRange
  If Len(C) > 0 Then
     C.Value = Trim(C.Value)
  End If
Next
End Sub

[drongo777]

Поставил, ничего не происходит

[Serge_Bliznykov]

ладно. ещё одна попытка.
пробуйте

Option Explicit

Sub TrimAll()
Dim C As Range, s$, i%, symb%
For Each C In ActiveSheet.UsedRange
  If Len(C.Value) > 0 Then
     s = Trim(C.Value)
     i = Len(s)
     While (i > 1) And (Asc(Mid(s, i, 1)) < 33)
        i = i - 1
     Wend
     C.Value = Left(s, i)
  End If
Next
End Sub

[drongo777]

Супер! Спасибо большое!