VBA EXCEL Макрос удаляющий все пробелы в нужных фразах

Question

Никак не могу написать макрос,который бы работал как надо. По сути макрос должен быть аналогом "найти и заменить",но в моих объемах данных каждый раз вставлять значения и вручную убирать пробел слишком долго. Задача заключается в том,чтобы удалить все пробелы из введённого в поле выражения. То есть,к примеру из фраз "Небо голубое облачное" "Небо голубое ясное" сделать "Небоголубое облачное" "Небоголубое ясное" введя "Небо голубое".С VBA дела никогда не имел,поэтому если можно,попроще как-то объясните,пожалуйста. Есть такой код:

Sub DeleteSpaceBetweenWords2()
'Update by Extendoffice 2018/5/24
    Dim myWord As String
    Dim Spaceless As String
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Cells
    xFind = Application.InputBox("Введите слово:", "Удаляем пробелы", , , , , 2)
    xRep = Replace(xFind, " ", "")
    If xFind = "False" Or xRep = "False" Then Exit Sub
    xRg.Replace xFind, xRep, xlPart, xlByRows, False, False, False, False
End Sub

Но у него несколько проблем: 1)Если у фразы несколько пробелов,то ничего не произойдет,так как в реплейсе указан только один пробел. 2)Если в ячейке несколько выражений для которых надо удалить пробелы,удалит он только у первой попавшейся в ячейке фразы.

Answer 1

Так не получится, если учитывать условия: Если у фразы несколько пробелов и Если в ячейке несколько выражений для которых надо удалить пробелы

Перед заменой нужно каждую фразу чистить от лишних пробелов. Это можно сделать в цикле с помощью Application.Trim (VBA-шный Trim удаляет только крайние пробелы)

Sub DeleteSpaceBetweenWords2()
    Dim xFind As String, xRep As String
    Dim xRg As Range, c As Range
    
    xFind = Application.InputBox("Введите текст:", "Удаляем пробелы", , , , , 2)
    xFind = Application.Trim(xFind)
    xRep = Replace(xFind, " ", "")
    If xRep = "" Or xRep = "False" Then Exit Sub
    
    Set xRg = Range("C2:D20")
    
    For Each Cell In xRg
        Cell.Value = Replace(Application.Trim(Cell.Value), xFind, xRep)
    Next Cell
End Sub

Примечание: в текстах будут удалены все повторы пробелов.

Set xRg = Cells - так Вы загоняете в память все ячейки листа (16 384*1 048 576). Диапазон нужно или задавать, или вычислять его границы.

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

БЛОГ НА HUSL

VBA EXCEL Макрос удаляющий все пробелы в нужных фразах

Ответы (1 шт):