Как удалить лишние пробелы в диапазоне

Удаление лишних пробелов с помощью функции

В Excel имеется специальная функция для удаления лишних пробелов =СЖПРОБЕЛЫ(ТЕКСТ). Она позволяет удалить пробелы вначале и в конце текста, а также удаляет лишние пробелы между словами. К сожалению, она обладает несколькими недостатками:

• Функцию приходится вбивать в отдельный столбец, потом переносить полученный текст без лишних пробелов в исходный столбец, а промежуточный столбец удалять.
• К сожалению функция пропускает неразрывные пробелы. 

Удаление пробелов в выделенном диапазоне

Согласитесь, что в некоторых случаях, намного удобнее было бы просто выделить исходный диапазон и нажать команду удалить пробелы. Такого функционала в Excel к сожалению нет. 

В составе надстройки VBA-Excel имеется такая функция, вот как ей пользоваться:

1. Выделите диапазон ячеек, в котором хотите удалить лишние пробелы.
2. Перейдите на вкладку VBA-Excel (она будет доступна после установки).
3. В меню Работа с текстом выберите команду Удалить пробелы.

Удаление пробелов с помощью макроса на VBA

'*****************************************************************************************************
' Метод         : DeleteDoubleSpace
' Разработчик   : Желтов Алексей
' Дата создания : 29.11.2015 21:31
' Описание      : Удаление двойных пробелов
'*****************************************************************************************************
Sub DeleteDoubleSpace()
    Dim cell As Range
    Dim WorkRng As Range
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    If Selection.CountLarge = 1 Or ActiveCell.MergeArea.CountLarge = Selection.CountLarge Then
        Set WorkRng = ActiveCell
        If Not Application.IsText(WorkRng) Or WorkRng.HasFormula = True Then
            MsgBox "Текстовые ячейки в указанном диапазоне отсутствуют.", 64, "Информация"
            Exit Sub
        End If
    Else
        Set WorkRng = Selection.SpecialCells(xlCellTypeVisible)
        Set WorkRng = WorkRng.SpecialCells(xlCellTypeConstants)
    End If
    
    If MsgBox("Двойные пробелы в выделенных ячейках будут заменены на одинарные. Операцию нельзя отменить. Уверены?", 36, "Подтверждение действия") <> vbOK Then Exit Sub
    
    For Each cell In WorkRng
        cell.Value = Replace(cell.Value, Chr(160), " ")
        cell.Value = Application.Trim(cell.Value)
    Next
End Sub