Добрый день!
Необходим макрос для удаления текста, цифр до точки "." и пробела после точки и перенос этого значения в другую ячейку.
"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.
Здравствуйте
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
Можно и без макроса формулой получить результат
=СЖПРОБЕЛЫ(ПСТР($A4; ПОИСК(".";$A4)+1;100))
Добрый день!
Serge 007 Ваш макрос не совсем правильно работает.
Из 2 строки удаляет только две первых цифры. Получается "7. ЭЮЭ" вместо "ЭЮЭ".
Плюс еще мне необходимо, чтобы имелась возможность указать в какую ячейку данное исправление будет вставляться т.к. это не соседняя ячейка. Данные переносятся из ст.G в ст.E.
Также в значении откуда нужно удалить цифры и точку с пробелом может быть несколько слов "1. Абвгд еежз".
boa Ваш вариант не подходит т.к. необходим именно макрос. Объем большой и каждый раз протягивать формулу не удобно и много времени уходит.
Цитата: 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. Абвгд еежз".
Но удалять надо, по прежнему, только цифры до точки с пробелом?
Добрый день!
Serge 007 спасибо все работает отлично.
ЦитироватьТут не понял, так надо "иметь возможность указывать ячейку" или "Данные переносятся из ст.G в ст.E?
Т.к. форма отчета не утверждена и может поменяться мне нужно иметь возможность указать из какого столбца в какой переносить данные.
Сейчас данные переносятся из ст.G в ст.E.
Цитата: alfatboy от 26.05.2022, 09:02...нужно иметь возможность указать из какого столбца в какой переносить данные...
Как Вы хотите указывать столбцы?
ЦитироватьКак Вы хотите указывать столбцы?
Перенос данных из (G13:до последнего символа) в (E13:до последнего символа).
Цитата: 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
(см. вложение)
Огромное спасибо!
Все работает как часы.