Здравствуйте, помогите, пожалуйста, есть макрос, который удаляет начальные, конечные и двойные пробелы, но он действует лишь на один столбец, как его переделать, чтобы он действовал на несколько столбцов, которые я могу прописывать?
[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]
Здравствуйте, помогите, пожалуйста, есть макрос, который удаляет начальные, конечные и двойные пробелы, но он действует лишь на один столбец, как его переделать, чтобы он действовал на несколько столбцов, которые я могу прописывать?
[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
а вы предлагаете действительно устроить здесь сеанс ясновидения? Откуда K-SerJC, может знать сколько у вас столбцов? Он попробовал угадать и не угадал
а вы предлагаете действительно устроить здесь сеанс ясновидения? Откуда K-SerJC, может знать сколько у вас столбцов? Он попробовал угадать и не угадал китин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
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
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
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
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]
Код
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] Поиграйтесь с примером
Лет пять назад обсуждали это с Алексеем(Казанский). Так вот, код выше опасен при смеси формул и значений. Убьет формулы. Даже такой код опасен(мое): [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
Ну и мои "пять копеек" из лежащего в 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 в конце для работы, естественно, не нужен, но позволяет визуализировать ячейки, обработанные макросом.
Ну и мои "пять копеек" из лежащего в 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 в конце для работы, естественно, не нужен, но позволяет визуализировать ячейки, обработанные макросом.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Суббота, 11.03.2017, 22:01