Макросы для удаления пробелов в excel

 

pinguindell

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

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

#1

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

#2

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

#3

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
 

Юрий М

Модератор

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

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

#7

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

#9

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 написал: красавчик Пирст

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

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

 

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, супер! спасибо!
Источник

Удаление лишних пробелов из строк с помощью кода 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 должен быть добавлен в тот же модуль.

Источник

В этом уроке мы создадим макрос, который удалит лишние пробелы в нужном диапазоне. Макрос будет работать как функция 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

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

Источник

Skip to content

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

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

Содержание

  1. Как макрос работает
  2. Код макроса
  3. Как этот код работает
  4. Как использовать

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

В этом макросе, мы перебираем диапазон, проверяя каждую ячейку с помощью функции 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. Шаг 1 объявляет две переменные объекта Range.
  2. Мы должны сохранить книгу перед запуском макроса.
  3. Шаг 3 заполняет переменную MyRange с целевым диапазоном.
  4. После того, как клетка активируется, Шаг 5 использует Not IsEmpty функцию, которая удаляет лишние пробелы
  5. Шаг 6 повторяет цикл, чтобы получить следующую ячейку. После просмотра всех ячеек в целевом диапазоне макрос заканчивается.

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

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

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

Источник

Удалить пробелы макросом

Mark1976

 Дата: Воскресенье, 26.03.2017, 23:09 |
Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 685


Репутация:
3
±

Замечаний:
0% ±


Excel 2010, 2013

Здравствуйте. Столкнулся с проблемой. Работаю удаленно с 1С, и вот при копировании чисел, они вставляются с пробелами. Вот так: 709 074,17. Найти и заменить работает не корректно. Если ставить пробел клавишей пробел ничего не заменяется, приходится этот пробел копировать и потом заменять. Такими кривыми числами я заполнил большую таблицу, и теперь мне надо удалить эти пробелы. Может есть макрос который может это сделать: Удалить пробелы из выделенных ячеек.

Сообщение отредактировал Mark1976 — Воскресенье, 26.03.2017, 23:10
 

Ответить

HoBU4OK

 Дата: Воскресенье, 26.03.2017, 23:23 |
Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 307


Репутация:
14
±

Замечаний:
0% ±


Excel 2010

Попробуйте написать макрос через рекордер… Вам его поправят и это не сложно (и вам опыт B) )
А ещё, возможно поможет, надстройка XLTools

Я думал, ты остроглазый лев, а ты слепая собака :-)

 

Ответить

Mark1976

 Дата: Воскресенье, 26.03.2017, 23:26 |
Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 685


Репутация:
3
±

Замечаний:
0% ±


Excel 2010, 2013

HoBU4OK, [vba]

Код

Sub Макрос1()
‘
‘ Макрос1 Макрос
‘

‘
    Range(«V32:Z35»).Select
    Selection.Replace What:=» «, Replacement:=»», LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

[/vba]

Готово

Сообщение отредактировал Mark1976 — Воскресенье, 26.03.2017, 23:37
 

Ответить

HoBU4OK

 Дата: Воскресенье, 26.03.2017, 23:32 |
Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 307


Репутация:
14
±

Замечаний:
0% ±


Excel 2010

Кнопочка другая для оформления) (вместоfx -#)
И как? Работает?

Я думал, ты остроглазый лев, а ты слепая собака :-)

Сообщение отредактировал HoBU4OK — Воскресенье, 26.03.2017, 23:33
 

Ответить

Саня

 Дата: Понедельник, 27.03.2017, 01:56 |
Сообщение № 5

Группа: Друзья

Ранг: Ветеран

Сообщений: 1067


Репутация:
560
±

Замечаний:
0% ±


XL 2016

вот так попробуйте:

[vba]

[/vba]

Сообщение отредактировал Саня — Понедельник, 27.03.2017, 01:56
 

Ответить

_Boroda_

 Дата: Понедельник, 27.03.2017, 03:57 |
Сообщение № 6

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16618


Репутация:
6465
±

Замечаний:
0% ±


2003; 2007; 2010; 2013 RUS

Первый макрос работает от ячейки V32 до последней заполненной ячейки столбца Z
Второй работает по выделенному диапазону (одну ячейку выделять нежелательно)
Меняет неразрывный пробел (как посоветовал выше Саня — действительно, из 1С он чаще всего и выгружается) и обычный. И потом преобразует полученное в числа
[vba]

Код

Sub tt()
    r0_ = 32
    r1_ = Range(«Z» & Rows.Count(3)).End(3).Row
    With Range(«V» & r0_ & «:Z» & r1_)
        .Replace What:=Chr(160), Replacement:=»»
        .Replace What:=Chr(32), Replacement:=»»
        .FormulaLocal = .FormulaLocal
    End With
End Sub
‘======================
Sub tt1()
    With Selection
        .Replace What:=Chr(160), Replacement:=»»
        .Replace What:=Chr(32), Replacement:=»»
        .FormulaLocal = .FormulaLocal
    End With
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов…
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

 

Ответить

Mark1976

 Дата: Понедельник, 27.03.2017, 18:09 |
Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 685


Репутация:
3
±

Замечаний:
0% ±


Excel 2010, 2013

Boroda, спасибо. Макрос работает безупречно.
 

Ответить
Источник

Понравилась статья? Поделить с друзьями:
  • Макросы для таблиц excel скачать
  • Макросы для сохранения в word
  • Макросы для создания графиков в excel
  • Макросы для скрытия строк в excel
  • Макросы для сводных таблиц в excel