Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Макрос удаления лишних пробелов в Excel
 
#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 строк.

Помогите пожалуйста оптимизировать код так, чтобы макрос работал быстрее, если это возможно.
Спасибо.
 
 
 
#2
16.05.2013 10:05:26
Код
With Range("I1", Cells(Rows.Count, "I").End(xlUp))
    .Value = Evaluate("INDEX(TRIM(" & .Address & "),)")
End With
 
 
 
#3
16.05.2013 10:19:37
Если не ошибаюсь, то можно еще так:
Код
With Range("I1", Cells(Rows.Count, "I").End(xlUp))
    .Value = Application.Trim(.Value)
End With
В принципе подход тот же.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#4
16.05.2013 10:42:30
Казанский, The_Prist, спасибо большое. Как говориться - все гениальное просто !  :)
 
 
 
#5
16.05.2013 11:41:11
Забыл добавить ложку дегтя в примечание к своему коду. Код Казанского лучше, т.к. обработает любую строку.
Мой код не работает в случае, если длина строки внутри ячейке больше 255 символов.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#6
10.12.2014 14:22:50
Добрый день. А можно переделать этот макрос, чтоб он удалял не лишние, а все пробелы в выделенных ячейках?
Изменено: fvg - 10.12.2014 22:57:44
 
 
 
#7
10.12.2014 14:31:30
Вариант:
Код
Sub DeleteSpace()
Dim rCell As Range
    For Each rCell In Selection
        rCell = Replace(rCell, " ", "")
    Next
End Sub
 
 
 
#8
10.12.2014 16:02:13
Юрий М, все работает, cпасибо большое!  
 
 
 
#9
10.12.2014 16:14:39
Эээ... А цикл-то зачем? Достаточно
Код
Selection.Replace " ", ""
 
 
 
#10
18.04.2016 15:09:53
Цитата
The_Prist написал: End With
красавчик Пирст))) помогло мне наконецто, ато целый день мучился))
 
 
 
#11
18.04.2016 15:36:35
Цитата
camypai написал: красавчик Пирст
Так еще Диму никто не обзывал :D
Я сам - дурнее всякого примера! ...
 
 
 
#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
 
 
 
#13
19.05.2016 13:59:20
Как удалить пробелы внутри числа (неразрывный пробел) с помощью макроса. Сейчас использую «Найти и Заменить», так как формулу =СЖПРОБЕЛЫ(ПОДСТАВИТЬ(J5;СИМВОЛ(160);"";1))*1 использовать в моем случае не удобно.
 
 
 
#14
19.05.2016 14:18:17
lazareva!
Посмотрите эту тему
 
 
 
#15
19.05.2016 15:18:10
Спасибо, Мотя. Пробел забрала, но проблема не решена, сума не считает.
 
 
 
#16
19.05.2016 16:06:41
Как профессионально решить проблему - я не знаю.
Советую создать новую тему на формуме: она непременно привлечет специалистов.
Примитивный вариант:
1. скопировать столб с данными в "Блокнот",
2. выделить Ваш "пробел",
3. в "Блокноте" в режиме "Заменить" избавиться от него в Ваших данных,
4. из "Блокнота" вернуть данные в Excel.
 
 
 
#17
19.05.2016 16:24:26
Не, Матреш, будем проще :)
Выделите столбец с корявыми числами - данные - текст по столбцам - ок.
Ну или в окне Immeiate:
Код
[j:j].texttocolumns
Изменено: kuklp - 19.05.2016 16:27:49
Я сам - дурнее всякого примера! ...
 
 
 
#18
19.05.2016 17:40:06
Спасибо, kuklp, сработало (окно Immeiate)! Остался один вопрос. Данные в документ вносятся каждый день. Что делать после ввода новых данных?
Изменено: lazareva - 19.05.2016 17:41:34
 
 
 
#19
19.05.2016 17:44:58
Да хоть то же самое. Или можете оформить его макросом, повесить на кнопку:
Код
sub www(): [j:j].texttocolumns: end sub
Я сам - дурнее всякого примера! ...
 
 
 
#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
 
 
 
#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
Я сам - дурнее всякого примера! ...
 
 
 
#22
20.05.2016 09:50:31
kuklp, большое спасибо! То что надо!
 
 
 
#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
Я сам - дурнее всякого примера! ...
 
 
 
#24
04.09.2017 23:08:42
Подскажите, пожалуйста, как переделать код Казанского, чтобы он выполнялся не только в отдельном столбце, а в произвольно выбранном диапазоне?
 
 
 
#25
19.04.2018 08:53:25
Казанский, The_Prist, Спасибо ОГРОМНОЕ! Очень мне помогли ваши решения.
 
 
 
#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 стоит автофильтр и часть строк скрыто, поэтому надо, чтобы обрабатывались только видимые ячейки
 
 
 
#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
 
 
 
#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
Я сам - дурнее всякого примера! ...
 
 
 
#29
15.07.2019 17:36:20
Добавлю, что Application.Trim при применении к массиву равен по скорости применению в прямом цикле, только запись короче
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#30
16.07.2019 08:01:56
kuklp, casag, супер! спасибо!
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх