Профессиональные приемы работы в Microsoft Excel

Пожалуйста, войдите или зарегистрируйтесь.


Расширенный поиск  

Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Автор Тема: Удаление текста в ячейке до определенного символа  (Прочитано 235 раз)

0 Пользователей и 1 Гость просматривают эту тему.

alfatboy

  • Пользователь
  • **
  • Уважение: +1/-0
  • Оффлайн Оффлайн
  • Сообщений: 24

Добрый день!
Необходим макрос для удаления текста, цифр до точки "." и пробела после точки и перенос этого значения в другую ячейку.
"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.
« Последнее редактирование: 20.05.2022, 14:20:44 от alfatboy »
Записан

Serge 007

  • Администратор
  • Ветеран
  • *****
  • Уважение: +341/-0
  • Оффлайн Оффлайн
  • Сообщений: 3 038
    • Мир Excel

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

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
Яндекс-деньги: 41001419691823 | WMR:126292472390

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Онлайн Онлайн
  • Сообщений: 597
  • Доброта спасет мир...

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

alfatboy

  • Пользователь
  • **
  • Уважение: +1/-0
  • Оффлайн Оффлайн
  • Сообщений: 24

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

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

Serge 007

  • Администратор
  • Ветеран
  • *****
  • Уважение: +341/-0
  • Оффлайн Оффлайн
  • Сообщений: 3 038
    • Мир Excel

Serge 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

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

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

alfatboy

  • Пользователь
  • **
  • Уважение: +1/-0
  • Оффлайн Оффлайн
  • Сообщений: 24

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

Т.к. форма отчета не утверждена и может поменяться мне нужно иметь возможность указать из какого столбца в какой переносить данные.
Сейчас данные переносятся из ст.G в ст.E.
Записан

Serge 007

  • Администратор
  • Ветеран
  • *****
  • Уважение: +341/-0
  • Оффлайн Оффлайн
  • Сообщений: 3 038
    • Мир Excel

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

alfatboy

  • Пользователь
  • **
  • Уважение: +1/-0
  • Оффлайн Оффлайн
  • Сообщений: 24

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

Serge 007

  • Администратор
  • Ветеран
  • *****
  • Уважение: +341/-0
  • Оффлайн Оффлайн
  • Сообщений: 3 038
    • Мир Excel

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

С данной задачей справляется уже написанный макрос, если в нем, вручную, указать столбцы 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

Если, всё же, надо указывать столбцы (исходный и результирующий), так как
Т.к. форма отчета не утверждена и может поменяться
то я предлагаю так: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
Яндекс-деньги: 41001419691823 | WMR:126292472390

alfatboy

  • Пользователь
  • **
  • Уважение: +1/-0
  • Оффлайн Оффлайн
  • Сообщений: 24

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



Темы без ответов

27.05.2022 14:38 конструкция из Shape 261
09.08.2019 14:09 Макрос для заполнения таблиц через форму 5159
18.07.2019 16:02 Рассылка почты из Excel при помощи почтовой программы TheBAT! 4543
07.02.2019 01:36 Как удалить дубликаты из выпадающего связанного списка? 6126
03.03.2018 00:00 Подсчет отработанного времени, за исключением заранее определенных перерывов 3220
23.05.2017 11:20 Копирование данных из одной таблицы в умную таблицу по условию 5043
15.03.2017 15:45 автозамена картинок PowerPoint 3952
11.03.2017 13:43 Изменить нумерацию страниц 3889
07.02.2017 18:43 Блокировка ячеек по наступлению даты 3008
28.08.2016 19:29 Одинаковые заголовки после обновления оглавления 3496





Яндекс цитирования msexcel.ru Яндекс.Метрика

Страница сгенерирована за 0.128 секунд. Запросов: 117.