Изменить формат ячейки и удалить пробелы

[AleksandrH]

После выгрузки данных с ERP текстовые данные получаю с пробеламы в конце ("sku "), решил сделать макрос который в выделенном диапазоне удалит пробелы в непустых ячейках и преобразует их в текстовый формат. Если встречаются ячейки с формулами-их не трогать.
Прошу совета что можно оптимизировать, реализировать более просто :-)

Sub ToTextV2()
    Dim cur_range As Range
    Dim mini_range As Range
    Dim work_range As Range
    Dim RangeAddress As String
    Dim Ranges() As String
    Dim counter As Integer, i As Integer
    Dim RowsSelected As Integer
    Dim ColsSelected As Integer
    Dim maxrow As Long, maxcol As Long
    Set cur_range = Selection
    RangeAddress = cur_range.Address
    Ranges = Split(RangeAddress, ",")
    For counter = LBound(Ranges) To UBound(Ranges)
        Set mini_range = Range(Ranges(counter))
        With mini_range
            Select Case .Address
                Case Cells.Address ' виділено весь лист
                    MsgBox "Whole sheet was selected" & Chr(10) & "It's maybe some joke, dude!"
                    Exit Sub
                Case .EntireColumn.Address ' виділено стовпець/ці
                    RowsSelected = 0: maxrow = 0
                    For i = .Column To .Column + .Columns.Count - 1
                        maxrow = Cells(.Rows.Count, i).End(xlUp).Row
                        RowsSelected = IIf(RowsSelected > maxrow, RowsSelected, maxrow) ' самий нижній рядок
                    Next i
                    Set work_range = Range(Cells(RowsSelected, .Column + .Columns.Count - 1), Cells(1, .Column))
                Case .EntireRow.Address ' виділено рядок/дки
                    ColsSelected = 0: maxcol = 0
                    For i = .Row To .Row + .Rows.Count - 1
                        maxcol = Cells(i, .Columns.Count).End(xlToLeft).Column
                        ColsSelected = IIf(ColsSelected > maxcol, ColsSelected, maxcol) ' самий правий стовпець
                    Next i
                    Set work_range = Range(Cells(.Row, 1), Cells(.Rows.Count - 1, ColsSelected))
                Case Else ' виділено звичайний діапазон
                    Set work_range = Range(Cells(.Row, .Column), Cells(.Row + .Rows.Count - 1, .Column + .Columns.Count - 1))
            End Select
            TrimValue work_range
        End With
    Next counter
 End Sub
 
 Function TrimValue(rng As Range)
    Dim cel As Range
        For Each cel In rng
        If cel <> "" And Not (cel.HasFormula) Then
            cel.NumberFormat = "@"
            Do While InStr(cel.Value2, "  ") > 0
                cel.Value2 = Replace(cel.Value2, "  ", " ")
            Loop
            cel.Value2 = Trim(cel.Value2)
        End If
        Next
 End Function

[Казанский]

Да, текста многовато Попробуйте так - со всем листом тоже можно работать

Sub AleksandrH()
Dim a As Range
  For Each a In Selection.SpecialCells(xlCellTypeConstants, xlTextValues).Areas
    a.NumberFormat = "@"
    a.Value = Application.Trim(a.Value)
  Next
End Sub

[AleksandrH]

pięknie!

А можете обяснить почему trim() обрезает пробелы слева-справа, а Application.Trim() и в тексте?

[Казанский]

Application.Trim это функция листа СЖПРОБЕЛЫ, она также заменяет множественные пробелы на один в строке. И, как многие другие функции листа, может работать с массивом.

[AleksandrH]

и еще маленькую доделку прошу. Если в выделении нету текстовых ячеек, как обработать ошибку 1004 (Не найдено ячеек = указанным условиям) на "Selection.SpecialCells(xlCellTypeC onstants, xlTextValues).Areas"

Решил

Sub ToText()
  Dim a As Range
  On Error GoTo norec
    For Each a In Selection.SpecialCells(xlCellTypeConstants, xlTextValues).Areas
        a.NumberFormat = "@"
        a.Value = Application.Trim(a.Value)
    Next
norec:
End Sub

[27102014]

А

On Error GoTo resume next

не поможет?

Может такая проверка

If   a.NumberFormat = "@" Then a.Value = Application.Trim(a.Value)

[AleksandrH]

Сообщение от 27102014

А

On Error GoTo resume next

не поможет?

имхо
On Error resume next "запустит" выполнение команд внутри цикла
а On Error Goto Norec "перепрыгнет" в конец процедуры.
визуально на листе результат вроде одинаковый.

Сообщение от 27102014

Может такая проверка

If   a.NumberFormat = "@" Then a.Value = Application.Trim(a.Value)

без on error... к етой строке не дойдет, потому что остановится на
Selection.SpecialCells(xlCellTypeCo nstants, xlTextValues, xlNumber).Areas

[Aleksandr H.]

Как "подшаманить" макроса чтобы отрабатывал и с установленным фильтром, те удалял пробелы и приводил формат в текст только видимых ячеек?