Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Функция сжать пробелы макросом (VBA)
 
#1
12.02.2020 23:45:50
Добрый вечер.

Необходима помощь в VBA, понимаю что функцию поиска выполняется через Find, но всё же нужна рука помощи, суть проблемы: в столбце I:I имеются данные в виде цифр в этом столбце имеются тысячные которые разделены пробелами с сотыми долями, необходимо найти и сжать все имеющиеся пробелы в столбце I:I.

Спасибо.
 
 
 
#2
12.02.2020 23:48:26
сжать<>удалить
 
 
 
#3
12.02.2020 23:52:40
Скорее всего это не обычный, а неразрывный пробел - 160.
 
 
 
#4
13.02.2020 00:23:47
Цитата
Andrey Ka написал:
данные в виде цифр
В виде (= формате) или просто это числа ?

? Replace() ?
 
 
 
#5
13.02.2020 00:24:31
т.е. удалить пробелы
 
 
 
#6
13.02.2020 00:26:00
Replace
 
 
 
#7
13.02.2020 01:04:17
Прикрепил пример. Это какой то баг видимо, не понимаю. В обоих случаях СЖПРОБЕЛЫ и Replace не помагает.
 
 
 
#8
13.02.2020 02:03:40
Нужно читать внимательно все сообщения:
Цитата
Юрий М написал: неразрывный пробел - 160.
=ПОДСТАВИТЬ(A2;СИМВОЛ(160);)
Код
Replace(Cells(2,1).Value,Chr$(160);"")
 
 
 
#9
13.02.2020 02:15:25
Код
Range("A2") = Replace(Range("A2"), Chr(160), "")
 
 
 
#10
13.02.2020 02:38:41
Помогло, но только для ячейки, как применить этот код к столбцу, менял на Columns (1) не помогает, ругается.
 
 
 
#11
13.02.2020 03:04:22
А включить макрорекордер и записать Ctrl+H не помогает?
 
 
 
#12
13.02.2020 03:37:09
В таком случае пробел не удаляется, пробовал.

Код
ActiveCell.Replace What:=" ", Replacement:=""
Изменено: Andrey Ka - 13.02.2020 03:38:38
 
 
 
#13
13.02.2020 07:29:59
Код
Sub УдалениеПробелов()
    Dim ws As Worksheet
    Dim i As Integer
    Dim LastRow As Integer
    Application.EnableEvents = False
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
     
    Set ws = Worksheets(1)
    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To LastRow
        ws.Cells(i, 1) = WorksheetFunction.Trim(ws.Cells(i, 1))
        ws.Cells(i, 1) = Replace(ws.Cells(i, 1), Chr(160), "") 
    Next i
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub
 
 
 
#14
13.02.2020 09:27:12
OFF:
Цитата
aequit: Application.Calculation = xlAutomatic
не у всех стоит/должен стоять автопресчёт по-умолчанию, поэтому лучше запоминать:
Код
Dim AC&
…
AC=Application.Calculation
Application.Calculation = xlCalculationManual
…
Application.Calculation = AC
Изменено: Jack Famous - 13.02.2020 09:27:40
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#15
13.02.2020 13:26:42
Цитата
Andrey Ka написал:
В таком случае пробел не удаляется, пробовал
Я ведь уже говорил, что там не привычный нам пробел, а неразрывный. Его код 160,
 
 
 
#16
14.02.2020 00:26:05
Друзья, спасибо за помощь, aequit ответил на мой вопрос, код работает, все супер.
 
 
 
Страницы: 1
Наверх