Убрать все пробелы в excel макрос - Word и Excel - помощь в работе с программами

На чтение 2 мин. Просмотров 3.3k.

Что делает макрос: Частая проблема при импорте данных из других источников — это начальные или конечные пробелы. Данный макрос позволит легко удалить лишние пробелы в ячейках.

Содержание

Как макрос работает
Код макроса
Как этот код работает
Как использовать

Как макрос работает

В этом макросе, мы перебираем диапазон, проверяя каждую ячейку с помощью функции Trim.

Код макроса

Sub UdalitLishnieProbeli()
'Шаг 1: Объявляем переменные
Dim MyRange As Range
Dim MyCell As Range
'Шаг 2: Сохранить книгу прежде, чем изменить данные?
Select Case MsgBox("Перед изменением ячеек. " & _
"Сохранить книгу?", vbYesNoCancel)
Case Is = vbYes
ThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
'Шаг 3: определяем целевой диапазон
Set MyRange = Selection
'Шаг 4: запускаем цикл по диапазону
For Each MyCell In MyRange
'Шаг 5: Убираем пробелы
If Not IsEmpty(MyCell) Then
MyCell = Trim(MyCell)
End If
'Шаг 6: Получаем следующую ячейку в диапазоне
Next MyCell
End Sub

Как этот код работает

Шаг 1 объявляет две переменные объекта Range.
Мы должны сохранить книгу перед запуском макроса.
Шаг 3 заполняет переменную MyRange с целевым диапазоном.
После того, как клетка активируется, Шаг 5 использует Not IsEmpty функцию, которая удаляет лишние пробелы
Шаг 6 повторяет цикл, чтобы получить следующую ячейку. После просмотра всех ячеек в целевом диапазоне макрос заканчивается.

Как использовать

Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:

Активируйте редактор Visual Basic, нажав ALT + F11.
Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
Выберите Insert➜Module.

Источник

Удаление лишних пробелов из строк с помощью кода VBA Excel. Функции LTrim, RTrim, Trim. Встроенная функция рабочего листа и пользовательская функция. Пример.

LTrim(строка) — удаление пробелов слева;
RTrim(строка) — удаление пробелов справа;
Trim(строка) — удаление пробелов слева и справа.

Встроенная функция рабочего листа

Функция VBA Trim удаляет пробелы только по краям строки, не затрагивая двойные, тройные и т.д. пробелы внутри текста. Для удаления всех лишних пробелов следует использовать встроенную функцию Trim рабочего листа Excel.

Синтаксис функции Trim рабочего листа:

WorksheetFunction.Trim(строка)

Пользовательская функция

Можно бороться с лишними пробелами и с помощью пользовательской функции:

Function myTrim(text As String) As String

‘Удаляем пробелы слева и справа строки

text = Trim(text)

‘Удаляем лишние пробелы внутри строки

Do While InStr(text, » «)

text = Replace(text, » «, » «)

Loop

myTrim = text

End Function

Пример удаления лишних пробелов

Сократим лишние пробелы в одной и той же строке с помощью функции Trim VBA, встроенной функции Trim рабочего листа Excel, пользовательской функции myTrim и сравним результаты.

Sub Primer()

Dim a1 As String

a1 = » Жили у бабуси «

MsgBox Trim(a1) & vbCrLf _

& WorksheetFunction.Trim(a1) _

& vbCrLf & myTrim(a1)

End Sub

Чтобы код примера сработал без ошибок, код пользовательской функции myTrim должен быть добавлен в тот же модуль.

Источник

pinguindell

Пользователь

Сообщений: 200
Регистрация: 01.01.1970

16.05.2013 09:54:10

Добрый день уважаемые знатоки Excel и VBA в частности.
На работе нужен макрос, который бы проверял каждую строчку в столбце I и удалял лишние пробелы в каждой ячейке данного столбца, если они конечно есть.
Вот написал следующий код:

Код

Sub DeleteSpaces()
'Удаляет лишние пробелы в столбце I
Application.ScreenUpdating = False
Dim poz As Range
Dim Ans As Integer
Dim Config As Integer
Config = vbYesNo + vbQuestion + vbDefaultButton2
Ans = MsgBox("Вы действительно хотите удалить лишние пробелы во всех значениях столбца I ?" & Chr(13) & "Данное действие необходимо выполнять при каждом импорте новых значений", Config)
Select Case Ans
    Case vbYes
For Each poz In Range("I1:I2000"
poz.Value = Trim$(poz)
Next poz
 MsgBox "Ошибки успешно исправлены" & Chr(13) & "*лишние пробелы удалены"
 Case vbNo
 End Select
End Sub

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

Помогите пожалуйста оптимизировать код так, чтобы макрос работал быстрее, если это возможно.
Спасибо.

Прикрепленные файлы

Example.xlsm (19.11 КБ)

Казанский

Пользователь

Сообщений: 8839
Регистрация: 11.01.2013

16.05.2013 10:05:26

Код
With Range("I1", Cells(Rows.Count, "I").End(xlUp)) .Value = Evaluate("INDEX(TRIM(" & .Address & "),)") End With

The_Prist

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

16.05.2013 10:19:37

Если не ошибаюсь, то можно еще так:

Код
With Range("I1", Cells(Rows.Count, "I").End(xlUp)) .Value = Application.Trim(.Value) End With

В принципе подход тот же.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

	Казанский, The_Prist, спасибо большое. Как говориться — все гениальное просто !

The_Prist

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Забыл добавить ложку дегтя в примечание к своему коду. Код Казанского лучше, т.к. обработает любую строку.
Мой код не работает в случае, если длина строки внутри ячейке больше 255 символов.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

fvg Пользователь Сообщений: 33 Регистрация: 10.12.2014	Добрый день. А можно переделать этот макрос, чтоб он удалял не лишние, а все пробелы в выделенных ячейках? Изменено: fvg — 10.12.2014 22:57:44

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

10.12.2014 14:31:30

Вариант:

Код
Sub DeleteSpace() Dim rCell As Range For Each rCell In Selection rCell = Replace(rCell, " ", "") Next End Sub

fvg Пользователь Сообщений: 33 Регистрация: 10.12.2014	Юрий М, все работает, cпасибо большое!

Влад

Пользователь

Сообщений: 1189
Регистрация: 24.12.2012

10.12.2014 16:14:39

Эээ… А цикл-то зачем? Достаточно

Код
Selection.Replace " ", ""

camypai

Пользователь

Сообщений: 32
Регистрация: 25.12.2015

#10

18.04.2016 15:09:53

Цитата
The_Prist написал: End With

красавчик Пирст))) помогло мне наконецто, ато целый день мучился))

kuklp

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#11

18.04.2016 15:36:35

Цитата
camypai написал: красавчик Пирст

Так еще Диму никто не обзывал

Я сам — дурнее всякого примера! …

sv2013

Пользователь

Сообщений: 657
Регистрация: 09.06.2015

#12

18.04.2016 17:26:05

еще вариант макроса ,кнопка vvv

Код

Sub vvv()
   Dim z, j&
   z = Range("I1:I" & Range("I" & Rows.Count).End(xlUp).Row).Value
With CreateObject("VBScript.RegExp"): .Pattern = "s": .Global = True
  For j = 1 To UBound(z)
     If .test(z(j, 1)) Then z(j, 1) = .Replace(z(j, 1), "")
   Next
  Range("I1").Resize(UBound(z), 1).Value = z
End With
End Sub

Прикрепленные файлы

example_19_04_2016_pl_пробел.xls (39 КБ)

lazareva Пользователь Сообщений: 8 Регистрация: 23.12.2014	Как удалить пробелы внутри числа (неразрывный пробел) с помощью макроса. Сейчас использую «Найти и Заменить», так как формулу =СЖПРОБЕЛЫ(ПОДСТАВИТЬ(J5;СИМВОЛ(160);»»;1))*1 использовать в моем случае не удобно.

Мотя Пользователь Сообщений: 3218 Регистрация: 25.12.2012

lazareva Пользователь Сообщений: 8 Регистрация: 23.12.2014	Спасибо, Мотя . Пробел забрала, но проблема не решена, сума не считает.

Мотя

Пользователь

Сообщений: 3218
Регистрация: 25.12.2012

Как профессионально решить проблему — я не знаю.
Советую создать новую тему на формуме: она непременно привлечет специалистов.
Примитивный вариант:
1. скопировать столб с данными в «Блокнот»,
2. выделить Ваш «пробел»,
3. в «Блокноте» в режиме «Заменить» избавиться от него в Ваших данных,
4. из «Блокнота» вернуть данные в Excel.

kuklp

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#17

19.05.2016 16:24:26

Не, Матреш, будем проще
Выделите столбец с корявыми числами — данные — текст по столбцам — ок.
Ну или в окне Immeiate:

Код
[j:j].texttocolumns

Изменено: kuklp — 19.05.2016 16:27:49

Я сам — дурнее всякого примера! …

lazareva Пользователь Сообщений: 8 Регистрация: 23.12.2014	Спасибо, kuklp , сработало (окно Immeiate)! Остался один вопрос. Данные в документ вносятся каждый день. Что делать после ввода новых данных? Изменено: lazareva — 19.05.2016 17:41:34

kuklp

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#19

19.05.2016 17:44:58

Да хоть то же самое. Или можете оформить его макросом, повесить на кнопку:

Код
sub www(): [j:j].texttocolumns: end sub

Я сам — дурнее всякого примера! …

lazareva

Пользователь

Сообщений: 8
Регистрация: 23.12.2014

#20

20.05.2016 09:33:50

Мне стыдно,что я научилась только копировать макросы, а написать самой трудновато. Немножко потрудившись, вот что получилось. Работает, но мня не устраивает то что надо выделять диапазон перед выполнением макроса. Диапазонов у меня много и они разбросаны. Как сделать так, чтоб он работал в столбце I и столбце J пока не разобралась. Еще нужно учесть, что в этих столбцах будут данные, которые уже прошли через макрос

Код
Sub удалить_неразрывный_пробел() Dim rCell As Range For Each rCell In Selection rCell = Replace(rCell, Chr(160), "") rCell.TextToColumns Next End Sub

Изменено: lazareva — 20.05.2016 09:35:41

kuklp

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#21

20.05.2016 09:42:43

Код
Public Sub www() With Intersect(ActiveSheet.UsedRange, [i:j]) .Replace Chr(160), "", 2 .Replace ",", ".", 2 End With End Sub

Я сам — дурнее всякого примера! …

lazareva Пользователь Сообщений: 8 Регистрация: 23.12.2014	kuklp , большое спасибо! То что надо!

kuklp

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#23

20.05.2016 09:51:39

Вариант:

Код
Public Sub www() Intersect(ActiveSheet.UsedRange, [i:j]).Replace Chr(160), "", 2 Intersect(ActiveSheet.UsedRange, [i:i]).TextToColumns Intersect(ActiveSheet.UsedRange, [j:j]).TextToColumns End Sub

Я сам — дурнее всякого примера! …

IvI80 Пользователь Сообщений: 36 Регистрация: 04.09.2017	Подскажите, пожалуйста, как переделать код Казанского, чтобы он выполнялся не только в отдельном столбце, а в произвольно выбранном диапазоне?

GroshevDV Пользователь Сообщений: 16 Регистрация: 27.03.2018	Казанский, The_Prist, Спасибо ОГРОМНОЕ! Очень мне помогли ваши решения.

DARR

Пользователь

Сообщений: 42
Регистрация: 10.02.2016

#26

15.07.2019 12:58:12

Цитата
Казанский написал: With Range(«I1», Cells(Rows.Count, «I»).End(xlUp)) .Value = Evaluate(«INDEX(TRIM(» & .Address & «),)») End With

Добрый день. Как в данном макросе задать только видимый диапазон ячеек столбца I ? Дело в том, что на столбце A стоит автофильтр и часть строк скрыто, поэтому надо, чтобы обрабатывались только видимые ячейки

casag

Пользователь

Сообщений: 175
Регистрация: 11.06.2018

#27

15.07.2019 16:53:16

DARR, у меня получилось так

Код
Sub csg() Dim iCell As Range For Each iCell In Range("I1", Cells(Rows.Count, "I").End(xlUp)) If iCell.EntireRow.Hidden = False Then iCell.Value = Application.Trim(iCell.Value) End If Next End Sub

kuklp

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#28

15.07.2019 17:05:00

Так д.б. шустрей:

Код
Sub www() Dim a As Range For Each a In Range("I1", Cells(Rows.Count, "I").End(xlUp)).SpecialCells(12).Areas a.Value = Application.Trim(a.Value) Next End Sub

Я сам — дурнее всякого примера! …

Jack Famous

Пользователь

Сообщений: 10852
Регистрация: 07.11.2014

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

Добавлю, что Application.Trim при применении к массиву равен по скорости применению в прямом цикле, только запись короче

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

DARR Пользователь Сообщений: 42 Регистрация: 10.02.2016	#30 16.07.2019 08:01:56 kuklp, casag, супер! спасибо!

Источник

В этом уроке мы создадим макрос, который удалит лишние пробелы в нужном диапазоне. Макрос будет работать как функция Excel СЖПРОБЕЛЫ. Если вы хотите при помощи VBA сделать то, что делает функция СЖПРОБЕЛЫ, то вы попали по адресу.

Данные, в которых нужно удалять лишние пробелы находятся в диапазоне A2:A4:

Мы будем пользоваться функцией Application.Trim:

Sub triming()
    ' Переменная для диапазона
    Dim trim_range  As Range
    
    ' Присваиваем значение объектной переменной
    Set trim_range = Range("a2:a4")
    
    ' Выделяем диапазон
    trim_range.Select
    
    ' Удаляем лишние пробелы
    With Selection
        .Value = Application.Trim(.Value)
    End With

End Sub

В результате получим данные без лишних пробелов:

Источник

I’m trying to delete the spaces that I have in each field of the column «A» this spaces are at the end of the string some of the string has 3 spaces others 4. When I run the code, I don’t have error, so I think I have a bug because nothing happened when is running.

Dim result As String
Last = Cells(Rows.Count, "A").End(xlUp).Row
    For i = Last To 1 Step -1
      If (Right(Cells(i, "A").Value, 4)) Like "    " Or (Right(Cells(i, "A").Value, 3)) Like "   " Then
        result = Replace(Cells(i, "A"), " ", "")
    End If
Next i

halfer

19.8k17 gold badges97 silver badges185 bronze badges

asked Aug 14, 2015 at 15:42

In your specific case, the problem is that you’re storing the replacement value in a string variable named result, then doing nothing with it. If you want it to be in the Cell, you have to add it back in there, such as:

Cells(I, "A").Value = result

Keep in mind, there is an Application.Trim method that can actually save a bit of time over looping. Experiment with code such as:

Dim rng as Range

set rng = Range("A1:A10")
rng.Value = Application.Trim(rng)

answered Aug 14, 2015 at 15:44

Currently you are not actually updating the cell in the loop, you just;

result = Replace(Cells(i, "A"), " ", "")

You should:

Cells(i, "A") = Replace(Cells(i, "A"), " ", "")

Or better

Cells(i, "A") = rtrim$(Cells(i, "A"))

Which will remove all right spaces. You can probably remove the if check as well.

answered Aug 14, 2015 at 15:45

Alex K.Alex K.

170k30 gold badges263 silver badges286 bronze badges

What are expecting this code to do? as currently the values are being read into result. It would also be better to use trim to remove trailing spaces.

Dim result As String
Last = Cells(Rows.Count, "A").End(xlUp).Row
    For i = Last To 1 Step -1
        result = RTrim(Cells(i, "A"))
    Next i

answered Aug 14, 2015 at 15:44

99moorem99moorem

1,9551 gold badge15 silver badges27 bronze badges

Источник

I created a macro for removing all whitespace in a string, specifically an email address. However it only removes about 95% of the whitespace, and leaves a few.

My code:

Sub NoSpaces()
    Dim w As Range

    For Each w In Selection.Cells
        w = Replace(w, " ", "")
    Next
End Sub

Things I have tried to solve the issue include:

~ Confirmed the spaces are indeed spaces with the Code function, it is character 32 (space)
~ Used a substitute macro in conjuction with the replace macro
~ Have additional macro utilizing Trim function to remove leading and trailing whitespace
~ Made a separate macro to test for non-breaking spaces (character 160)
~ Used the Find and Replace feature to search and replace spaces with nothing. Confirmed working.

I only have one cell selected when I run the macro. It selects and goes through all the cells because of the Selection.Cells part of the code.

A few examples:

1 STAR MOVING @ ATT.NET
322 TRUCKING@GMAIL.COM
ALEZZZZ@AOL. COM.

These just contain regular whitespace, but are skipped over.

Источник

Никак не могу написать макрос,который бы работал как надо.
По сути макрос должен быть аналогом «найти и заменить»,но в моих объемах данных каждый раз вставлять значения и вручную убирать пробел слишком долго.
Задача заключается в том,чтобы удалить все пробелы из введённого в поле выражения.
То есть,к примеру из фраз «Небо голубое облачное» «Небо голубое ясное» сделать «Небоголубое облачное» «Небоголубое ясное» введя «Небо голубое».С 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)Если в ячейке несколько выражений для которых надо удалить пробелы,удалит он только у первой попавшейся в ячейке фразы.

Источник