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

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


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

Новости:

Из правил форума: Тема должна отражать суть вопроса, топики типа "help please" будут удаляться!

Автор Тема: Массовое "найти и заменить"  (Прочитано 4846 раз)

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

kaffs

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 3

Всем привет.

Ситуация такая: работаю с прайс-листами excel, где приходится каждый день переводить с украинского на русский наименования товаров, а так же заменять буквенный артикул на цифровой (букву заменять соответствующе-присвоенным числом).

Приходится каждый раз через поиск-замену по одной менять данные в 5-ти тысячах строк.

На одном из форумов спросил про возможность ускорить этот процесс. Т.е. один раз составить таблицу данных, в первом столбце которой будут данные, которые нужно найти, а во втором столбце данные, на которые нужно заменить найденное, и запустить скрипт или функцию, чтоб эксель отрабатывал замену отталкиваясь от этой таблички.

Мне подкинули файл, который я прикрепляю к этому посту. Все работает, но там одно маленькое "но" - в табличке замены данных начиная со второй строки заменяются на данные, которые находятся на напротив, а двумя строчками ниже.
Для примера - нужно все цифры заменить соответствующими словами. "1, 2, 3, 4, 5" заменяются на "один, три, пять, семь", вместо один, два, три, четыре, пять.

Подскажите, кто знает, как поправить эту ошибку?

Вот код макроса:

Sub ups()
For Each cell In Sheets("Лист1").Range("a1:a9")
a = cell.Row
b = cell.Count + 1
    Selection.Replace What:=cell.Value, Replacement:=cell(cell.Row, cell.Count + 1).Value, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Next
End Sub

Из "cell.Count + 1" пробовал убрать "+ 1" - ничего не вышло.
« Последнее редактирование: 16.04.2015, 23:14:32 от vikttur »
Записан

nilem

  • Постоялец
  • ***
  • Уважение: +67/-0
  • Оффлайн Оффлайн
  • Сообщений: 342
Re: Массовое "найти и заменить"
« Ответ #1 : 08.07.2011, 17:33:15 »

Если ничего принципиально не менять, то вот так попробуйте:
Sub ups()
Dim cll As Range
For Each cll In Sheets("Лист1").Range("a1:a6")
    Selection.Replace What:=cll.Value, Replacement:=cll.Next.Value, LookAt:=xlPart
Next
End Sub
Записан

kaffs

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 3
Re: Массовое "найти и заменить"
« Ответ #2 : 08.07.2011, 19:05:59 »

Большущее спасибо! работает как надо теперь!!! )))
« Последнее редактирование: 16.04.2015, 23:11:03 от vikttur »
Записан

alone7

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 7
Re: Массовое "найти и заменить"
« Ответ #3 : 16.04.2015, 12:35:09 »

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

Записан

vikttur

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +47/-0
  • Оффлайн Оффлайн
  • Сообщений: 965
Re: Массовое "найти и заменить"
« Ответ #4 : 16.04.2015, 23:11:39 »

alone7, вопрос не по теме. Создайте свою.
Записан

Димычч

  • Постоялец
  • ***
  • Уважение: +4/-0
  • Оффлайн Оффлайн
  • Сообщений: 134
Re: Массовое "найти и заменить"
« Ответ #5 : 17.04.2015, 05:14:32 »

Предлагаю добавить универсальности этой полезной функции: сделать возможным выполнить поиск/замену
1. на всём текущем листе (без предварительного выделения диапазона).
2. во всей книге.
Подскажите, как будет выглядеть этот макрос для первой и второй задачи? Сначала была мысль выводить окошко с выбором диапазона поиска, но в этом тоже есть свои минусы. Иногда удобнее использовать отдельные макросы. 
Записан

alone7

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 7
Re: Массовое "найти и заменить"
« Ответ #6 : 17.04.2015, 12:00:23 »

вам, конечно, виднее, насколько вопрос не по теме, но почему-то создавая новую тему я скопирую почти всё, что написано в этой теме)
Записан

vikttur

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +47/-0
  • Оффлайн Оффлайн
  • Сообщений: 965
Re: Массовое "найти и заменить"
« Ответ #7 : 17.04.2015, 12:07:21 »

Вы хотите заливать цветом. о чем в заглавной теме - ни слова.
Вы хотите ИЗМЕНИТЬ показанный код под свои нужды.
Не нужно копировать все. В сообщении указать проблему и прикрепить файл-пример.
Записан

vkontakte

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 2
Re: Массовое "найти и заменить"
« Ответ #8 : 08.02.2018, 10:08:21 »

Если ничего принципиально не менять, то вот так попробуйте:
Sub ups()
Dim cll As Range
For Each cll In Sheets("Лист1").Range("a1:a6")
    Selection.Replace What:=cll.Value, Replacement:=cll.Next.Value, LookAt:=xlPart
Next
End Sub
У меня задача следующая: нужно заменить ID категорий на Название категорий,
соответственно на Лист 1 в столбец А я загружаю список ID, в столбец B - Названия категорий
перехожу на Лист 2, в столбец А вставляю ID категорий, выделяю диапазон, нажимаю на кнопку, заменяет,
но во многих категориях добавляет цифры к Названию категории. Как исправить?
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +28/-0
  • Оффлайн Оффлайн
  • Сообщений: 501
  • Доброта спасет мир...
Re: Массовое "найти и заменить"
« Ответ #9 : 08.02.2018, 11:26:52 »

В вашем случае измените параметр

LookAt:=xlWhole
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

vkontakte

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 2
Re: Массовое "найти и заменить"
« Ответ #10 : 08.02.2018, 14:32:01 »

Огонь, всё работает! Благодарю!
« Последнее редактирование: 08.02.2018, 18:10:58 от vikttur »
Записан
 



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

22.05.2018 11:38 Скрипт написать который допишет данные в файл 413
03.03.2018 00:00 Подсчет отработанного времени, за исключением заранее определенных перерывов 771
14.02.2018 10:11 Подготовить читабельную отчетность по платежам 723
23.01.2018 13:46 Найти вероятность повторной покупки 702
12.01.2018 23:56 Сделать отчет на Power BI (Dashboard) 943
06.09.2017 10:43 Solver VBA не решает гиперболическое уравнение, но при этом решает гармоническое 964
17.08.2017 12:15 Гиперссылка и фильтр одновременно макрос 1262
23.05.2017 11:20 Копирование данных из одной таблицы в умную таблицу по условию 2806
15.03.2017 15:45 автозамена картинок PowerPoint 1719
11.03.2017 13:43 Изменить нумерацию страниц 1937





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

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