Удаление текста в ячейке до определенного символа

Автор alfatboy, 20.05.2022, 13:52

« назад - далее »

alfatboy

Добрый день!
Необходим макрос для удаления текста, цифр до точки "." и пробела после точки и перенос этого значения в другую ячейку.
"125. Абвг" должно получится "Абвг".
Нашел в инете макрос

Sub 1   
Dim i%
    i = InStr(1, [a4].Value, ".", vbTextCompare) + 2
    [b4].Value = Right([a4].Value, Len([a4].Value) - i + 1)
End Sub

но не знаю как сделать, чтобы он работал по диапазону (a4:до последней заполненной ячейки), а не только в ячейке а4.

Serge 007

Здравствуйте

Sub alfatboy()
Dim Rrange As Range
Dim LastROW As Long
LastROW = Application.WorksheetFunction.CountA(Range("a4:a1000")) + 3
    For Each Rrange In Range("a4:a" & LastROW)
        Rrange.Offset(0, 2) = Right(Rrange, 2 + InStr(1, Rrange, ". ", vbTextCompare))
    Next Rrange
End Sub
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

boa

Можно и без макроса формулой получить результат
=СЖПРОБЕЛЫ(ПСТР($A4; ПОИСК(".";$A4)+1;100))
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

alfatboy

Добрый день!
Serge 007 Ваш макрос не совсем правильно работает.
Из 2 строки удаляет только две первых цифры. Получается "7. ЭЮЭ" вместо "ЭЮЭ".
Плюс еще мне необходимо, чтобы имелась возможность указать в какую ячейку данное исправление будет вставляться т.к. это не соседняя ячейка. Данные переносятся из ст.G в ст.E.
Также в значении откуда нужно удалить цифры и точку с пробелом может быть несколько слов "1. Абвгд еежз".

boa Ваш вариант не подходит т.к. необходим именно макрос. Объем большой и каждый раз протягивать формулу не удобно и много времени уходит.

Serge 007

Цитата: alfatboy от 25.05.2022, 12:55Serge 007 Ваш макрос не совсем правильно работает.
Из 2 строки удаляет только две первых цифры. Получается "7. ЭЮЭ" вместо "ЭЮЭ".
Да, немного перепутал, не с той стороны отсчет удаляемых знаков вёл  ;D

Так будет работать корректно:Sub alfatboy()
Dim Rrange As Range
Dim LastROW As Long
LastROW = Application.WorksheetFunction.CountA(Range("a4:a1000")) + 3
    For Each Rrange In Range("a4:a" & LastROW)
        Rrange.Offset(0, 1) = Right(Rrange, Len(Rrange) - InStr(1, Rrange, ". ", vbTextCompare))
    Next Rrange
End Sub


Цитата: alfatboy от 25.05.2022, 12:55...еще мне необходимо, чтобы имелась возможность указать в какую ячейку данное исправление будет вставляться т.к. это не соседняя ячейка. Данные переносятся из ст.G в ст.E...
Тут не понял, так надо "иметь возможность указывать ячейку" или "Данные переносятся из ст.G в ст.E"?

Цитата: alfatboy от 25.05.2022, 12:55Также в значении откуда нужно удалить цифры и точку с пробелом может быть несколько слов "1. Абвгд еежз".
Но удалять надо, по прежнему, только цифры до точки с пробелом?
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

alfatboy

Добрый день!
Serge 007 спасибо все работает отлично.
ЦитироватьТут не понял, так надо "иметь возможность указывать ячейку" или "Данные переносятся из ст.G в ст.E?
Т.к. форма отчета не утверждена и может поменяться мне нужно иметь возможность указать из какого столбца в какой переносить данные.
Сейчас данные переносятся из ст.G в ст.E.

Serge 007

Цитата: alfatboy от 26.05.2022, 09:02...нужно иметь возможность указать из какого столбца в какой переносить данные...
Как Вы хотите указывать столбцы?
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

alfatboy

ЦитироватьКак Вы хотите указывать столбцы?
Перенос данных из (G13:до последнего символа) в (E13:до последнего символа).

Serge 007

Цитата: alfatboy от 26.05.2022, 10:00Перенос данных из (G13:до последнего символа) в (E13:до последнего символа).
Это это фиксированные столбцы, а не
Цитата: alfatboy от 26.05.2022, 09:02указать из какого столбца в какой переносить данные
...

С данной задачей справляется уже написанный макрос, если в нем, вручную, указать столбцы G и E:Sub alfatboy_old()
Dim Rrange As Range
Dim LastROW As Long
LastROW = Application.WorksheetFunction.CountA(Range("g4:g1000")) + 3
    For Each Rrange In Range("g4:g" & LastROW)
        Rrange.Offset(0, -2) = Right(Rrange, Len(Rrange) - InStr(1, Rrange, ". ", vbTextCompare))
    Next Rrange
End Sub


Если, всё же, надо указывать столбцы (исходный и результирующий), так как
Цитата: alfatboy от 26.05.2022, 09:02Т.к. форма отчета не утверждена и может поменяться
то я предлагаю так:Sub alfatboy()
Dim Rrange As Range, AD$
Dim LastROW As Long, CCol&

    With Application.InputBox("Выберите любую ячейку столбца с данными для удаления цифр", Type:=8)
        CCol = .Column
    End With
   
LastROW = Cells(Rows.Count, CCol).End(xlUp).Row

    With Application.InputBox("Выберите любую ячейку столбца для вставки", Type:=8)
        AD = .Column
    End With
   
    For Each Rrange In Range(Cells(1, CCol), Cells(LastROW, CCol))
        Rrange.Offset(0, AD - CCol) = Right(Rrange, Len(Rrange) - InStr(1, Rrange, ". ", vbTextCompare))
    Next Rrange
End Sub
(см. вложение)
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

alfatboy

Огромное спасибо!
Все работает как часы.