Новости:

Новая редакция правил форума: 2.4. Если вопрос или ответ содержится во вложенном файле, все-равно кратко описывайте в сообщении вопрос или суть решения. Это необходимо, чтобы тему можно было найти через поиск.

Главное меню

Сравнение и замена текста внутри ячейки на текст из базы

Автор Владимир Ананевич, 19.04.2013, 17:28

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

Владимир Ананевич

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

Нюансы:
Поиск фрагмента текста нужно проводить по всему листу, а не по конкретному столбцу.
Со временем во втором файле будут добавлятся новые изменение, тоесть количество строк будет рости.
Размер текста в первом файле будет сравнительно не большой, поэтому обрабатывать очень большие данные макросу не придется, но он будет работать часто, так как этих файлов будет достаточно много. Именно с этих соображений и хочется иметь такой макрос.
В принципе, базу с искомым текстом и его наследником можно создать прямо в макросе. таких фрагментов будет не более 20. много места не займут
Заранее большое спасибо за помощь!

sergo44441

Подскажите, производить замену нужно будет все время в одном и том же документе или скажем, во всех файлах, расположенных в определенной папке?
Не торопись, и все успеешь намного быстрее

Владимир Ананевич

#2
Нет, только в одном определенном файле!
Sub test()

Dim wb As Workbook, ws As Worksheet, mass, i As Long, wsr As Worksheet

Application.ScreenUpdating = False
Set wsr = ActiveSheet
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\2_база изменений.xlsx", ReadOnly:=True)
Set ws = wb.Sheets(1)

mass = ws.Range("A1").CurrentRegion.Value

For i = 2 To UBound(mass, 1)
    wsr.UsedRange.Replace What:=mass(i, 1), Replacement:=mass(i, 2), LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next i

wb.Close
Application.ScreenUpdating = True
End Sub