Удаление лишних пробелов в нескольких столбцах

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление лишних пробелов в нескольких столбцах (Макросы/Sub)

Liana88

Дата: Четверг, 09.03.2017, 05:04 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

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

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

Excel 2003

Здравствуйте, помогите, пожалуйста, есть макрос, который удаляет начальные, конечные и двойные пробелы, но он действует лишь на один столбец, как его переделать, чтобы он действовал на несколько столбцов, которые я могу прописывать?

[vba]

Код

c = 2
For i = 1 To Cells(Rows.Count, c).End(xlUp).Row
1:
If Left(Cells(i, c), 1) = " " Then Cells(i, c) = Right(Cells(i, c), Len(Cells(i, c)) - 1): GoTo 1
2:
If Right(Cells(i, c), 1) = " " Then Cells(i, c) = Left(Cells(i, c), Len(Cells(i, c)) - 1): GoTo 2
Do While InStr(Cells(i, c), " ") > 0
Cells(i, c) = Replace(Cells(i, c), " ", " ")
Loop
Next

[/vba]

Ответить

K-SerJC

Дата: Четверг, 09.03.2017, 07:27 | Сообщение № 2

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

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

Сообщений: 487

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

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

Excel 2013

Цитата Liana88, 09.03.2017 в 05:04, в сообщении № 1 ()

которые я могу прописывать?

С=2 выбираете второй столбец
пропишете другое число, будет с другим столбцом работать
можно написать:
[vba]

Код

c=InputBox "номер столбца"

[/vba]
тогда при вводе числа будет работать по нужному столбцу

Благими намерениями выстелена дорога в АД.

Ответить

Liana88

Дата: Четверг, 09.03.2017, 08:50 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

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

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

Excel 2003

K-SerJC, у меня 18 столбцов, предлагаете мне вручную каждый раз менять столбец?

Ответить

китин

Дата: Четверг, 09.03.2017, 08:59 | Сообщение № 4

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

Ранг: Экселист

Сообщений: 7019

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

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

Excel 2007;2010;2016

а вы предлагаете действительно устроить здесь сеанс ясновидения? Откуда K-SerJC, может знать сколько у вас столбцов? Он попробовал угадать и не угадал :'(

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Ответить

Liana88

Дата: Четверг, 09.03.2017, 09:16 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

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

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

Excel 2003

...как его переделать, чтобы он действовал на несколько столбцов...

Ответить

Pelena

Дата: Четверг, 09.03.2017, 09:43 | Сообщение № 6

Группа: Админы

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

Сообщений: 19197

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

Замечаний: ±

Excel 365 & Mac Excel

Цитата Liana88, 09.03.2017 в 05:04, в сообщении № 1 ()

несколько столбцов, которые я могу прописывать

[vba]

Код

arrC = Array(2, 4, 5, 8) ' здесь прописываете столбцы
For each c in arrC
For i = 1 To Cells(Rows.Count, c).End(xlUp).Row
1:
If Left(Cells(i, c), 1) = " " Then Cells(i, c) = Right(Cells(i, c), Len(Cells(i, c)) - 1): GoTo 1
2:
If Right(Cells(i, c), 1) = " " Then Cells(i, c) = Left(Cells(i, c), Len(Cells(i, c)) - 1): GoTo 2
Do While InStr(Cells(i, c), " ") > 0
Cells(i, c) = Replace(Cells(i, c), " ", " ")
Loop
Next i
Next

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Gustav

Дата: Четверг, 09.03.2017, 11:29 | Сообщение № 7

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

Ранг: Участник клуба

Сообщений: 2757

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

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

начинал с Excel 4.0, видел 2.1

Цитата Liana88, 09.03.2017 в 05:04, в сообщении № 1 ()

Do While InStr(Cells(i, c), " ") > 0
Cells(i, c) = Replace(Cells(i, c), " ", " ")
Loop

Коллеги, вы по ходу не отошли ещё после праздника

Какой InStr, какой Replace?! Есть же функции Trim, LTrim, RTrim, наконец, WorksheetFunction.Trim !

P.S. Вместо цитируемого цикла всего один оператор сделает то же самое
[vba]

Код

Cells(i, c) = WorksheetFunction.Trim(Cells(i, c))

[/vba]

P.P.S. Ну, и весь код вообще существенно упрощается:
[vba]

Код

arrC = Array(2, 4, 5, 8) ' здесь прописываете столбцы
For each c in arrC
    For i = 1 To Cells(Rows.Count, c).End(xlUp).Row
        Cells(i, c) = WorksheetFunction.Trim(Cells(i, c))
    Next i
Next

[/vba]

МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Четверг, 09.03.2017, 11:36

Ответить

Pelena

Дата: Четверг, 09.03.2017, 11:47 | Сообщение № 8

Группа: Админы

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

Сообщений: 19197

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

Замечаний: ±

Excel 365 & Mac Excel

В суть кода даже не вникала (каюсь). Отвечала на поставленный вопрос

Цитата Liana88, 09.03.2017 в 09:16, в сообщении № 5 ()

как его переделать, чтобы он действовал на несколько столбцов

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

RAN

Дата: Четверг, 09.03.2017, 16:32 | Сообщение № 9

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

Ранг: Экселист

Сообщений: 5660

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

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

2010

С учетом того, что вообще сложно представить, где в данных нужны двойные пробелы

Цитата Gustav, 09.03.2017 в 11:29, в сообщении № 7 ()

весь код вообще существенно упрощается:

Даже на Мяу не тянет

[vba]

Код

Sub Мя()
ActiveSheet.UsedRange = Application.Trim(ActiveSheet.UsedRange)
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

Gustav

Дата: Четверг, 09.03.2017, 16:56 | Сообщение № 10

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

Ранг: Участник клуба

Сообщений: 2757

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

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

начинал с Excel 4.0, видел 2.1

Цитата RAN, 09.03.2017 в 16:32, в сообщении № 9 ()

ActiveSheet.UsedRange = Application.Trim(ActiveSheet.UsedRange)

Надо же, так для диапазона работает!

А типа вот так, как советуют ОТТУДА, нет:
[vba]

Код

ActiveSheet.UsedRange = Application.WorksheetFunction.Trim(ActiveSheet.UsedRange) 'Type mismatch :(((

[/vba]

МОИ: Ник, Tip box: 41001663842605

Ответить

KuklP

Дата: Пятница, 10.03.2017, 00:10 | Сообщение № 11

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

Ранг: Старожил

Сообщений: 2369

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

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

2003-2010

Лет пять назад обсуждали это с Алексеем(Казанский). Так вот, код выше опасен при смеси формул и значений. Убьет формулы. Даже такой код опасен(мое):
[vba]

Код

Public Sub www() 'KukLP
ActiveSheet.UsedRange.SpecialCells(2).Value = Application.Trim(ActiveSheet.UsedRange.SpecialCells(2).Value)
End Sub

[/vba]Лучше как предложил Алексей:
[vba]

Код

Sub TrimSpaces() 'Казанский
    Dim a As Range
    For Each a In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas
        a = Application.Trim(a)
    Next
End Sub

[/vba]
Поиграйтесь с примером

К сообщению приложен файл: Application_Tri.xls (37.5 Kb)

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Сообщение отредактировал KuklP - Пятница, 10.03.2017, 00:14

Ответить

Liana88

Дата: Пятница, 10.03.2017, 03:12 | Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

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

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

Excel 2003

Огромнейшее спасибо всем!

Ответить

Alex_ST

Дата: Суббота, 11.03.2017, 21:59 | Сообщение № 13

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

Ну и мои "пять копеек" из лежащего в Personal и регулярно используемого:[vba]

Код

Sub Trim_By_Formula()   ' применить функцию СЖПРОБЕЛЫ к видимым ячейкам выделенного диапазона
   Dim rRng As Range, rArea As Range
   Set rRng = Intersect(ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible), ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants))
   If Not rRng Is Nothing Then
      Application.ScreenUpdating = False: Application.EnableEvents = False
      With rRng
         .Replace Chr(160), " ", xlPart   ' Chr(160) - неразрывный пробел
         For Each rArea In .Areas
            rArea.Value = Application.Trim(rArea)   ' СЖПРОБЕЛЫ
         Next
         .Replace " " & Chr(10), Chr(10), xlPart   ' пробел перед LF
         .Replace Chr(10) & " ", Chr(10), xlPart   ' пробел после LF
         .Select
      End With
      Application.ScreenUpdating = True: Application.EnableEvents = True
   End If
End Sub

[/vba]P.S. .Select в конце для работы, естественно, не нужен, но позволяет визуализировать ячейки, обработанные макросом.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Суббота, 11.03.2017, 22:01

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление лишних пробелов в нескольких столбцах (Макросы/Sub)

Страница 1 из 1
1