Сравнение двух файлов и замена ячеек

[Morozeckiy]

Всем привет.
Наверное мой вопрос просто в экселе не решить, поэтому может кто даст наводку где копать. Может в какой другой ветке. Может можно програмку написать.
Смысл такой:
Имеем 2 файла с названиями.
Файл1 в столбце А имеет правильные названия. В столбцах B,C,D и т.д находятся неправильные синонимы правильного названия в этой строке.
Пример прикрепил.
Берем файл2. В его столбце (А) неправельные названия.
Необходимо, чтобы столбец (А), построчно сравнивался со столбцами B,C,D и в случае совпадения на какой то n строке, сравниваемая ячейка из столбца (A) заменялась на ячейку Аn из первого файла.
Как то так.
Спасибо.

[IgorGO]

Ниже текст макроса прежде чем его выполнить проделайте следующее:
1. файл с правильными именами должен называться эталон.xlsx и быть открытым (файл 1)
2. правильные имена в нем должны быть в первой колонке 1-ГО ЛИСТА!
3. отрываете файл, в котором следует заменить имена на правильные (файл 2)
4. ПРИ АКТИВНОМ ФАЙЛЕ 2 выполните этот

Sub SetCorrectName()
  Dim r As Long, rg As Range, NoFound As Range, wb0 As Workbook
  For Each wb0 In Workbooks
    If wb0.Name = "Эталон.xlsx" Then Exit For
  Next
  If wb0.Name <> "Эталон.xlsx" Then MsgBox "не найдена книга с эталонными названиями!", vbCritical, "Караул!!!": Exit Sub
  r = 1
  With wb0.Worksheets(1)
    Do While Not IsEmpty(Cells(r, 1))
      Set rg = .Cells.Find(Cells(r, 1), .Cells(1), xlValues, xlWhole)
      If rg Is Nothing Then
        If NoFound Is Nothing Then Set NoFound = Cells(r, 1) Else Set NoFound = Union(NoFound, Cells(r, 1))
      Else
        Cells(r, 1) = .Cells(rg.Row, 1)
      End If
      r = r + 1
    Loop
  End With
  If Not NoFound Is Nothing Then
    NoFound.Select
    MsgBox NoFound.Address, vbOKOnly, "Не найдено шт.: " & NoFound.Cells.Count & ". Они отмечены можно их скопировать, удалить, залить цветом и пр."
  End If
End Sub

замены производятся ТОЛЬКО для значений из 1-й колонки редактируемого файла.

[Hugo121]

Думаю алгоритм может быть таким - цикл по эталонам, заносим в словарь синонимы как ключи, как item - правильное название.
Далее цикл по обрабатываемым данным - если нашли в словаре, то заменяем на item. Очень быстро, если данных много - обрабатывайте всё через массивы.
Если бы был пример в файле - был бы пример в коде.
Теперь уже поздно...

Как вариант - без всяких синонимов:
цикл по эталонам, в каждом удаляем пробелы/точки/тире, заменяем кириллицу на латиницу (на всякий пожарный), записываем получившееся как ключ в словарь, как итем пишем эталон.
Далее цикл по обрабатываемым данным - аналогично стараемся получить ключ, если есть в словаре - меняем на эталон из словаря.
Сравнение в словаре ставим текстовое - чтоб не мешал регистр. Ну или можно все ключи свести к одному регистру.
Такой подход исправит всё, кроме пары Dr.Pepper-Pepper. Да это вообще разные ведь вещи - человек и специя, их нельзя путать!

[Morozeckiy]

Сообщение от IgorGO

Ниже текст макроса прежде чем его выполнить проделайте следующее:
1. файл с правильными именами должен называться эталон.xlsx и быть открытым (файл 1)
2. правильные имена в нем должны быть в первой колонке 1-ГО ЛИСТА!
3. отрываете файл, в котором следует заменить имена на правильные (файл 2)
4. ПРИ АКТИВНОМ ФАЙЛЕ 2 выполните этот

Sub SetCorrectName()
  Dim r As Long, rg As Range, NoFound As Range, wb0 As Workbook
  For Each wb0 In Workbooks
    If wb0.Name = "Эталон.xlsx" Then Exit For
  Next
  If wb0.Name <> "Эталон.xlsx" Then MsgBox "не найдена книга с эталонными названиями!", vbCritical, "Караул!!!": Exit Sub
  r = 1
  With wb0.Worksheets(1)
    Do While Not IsEmpty(Cells(r, 1))
      Set rg = .Cells.Find(Cells(r, 1), .Cells(1), xlValues, xlWhole)
      If rg Is Nothing Then
        If NoFound Is Nothing Then Set NoFound = Cells(r, 1) Else Set NoFound = Union(NoFound, Cells(r, 1))
      Else
        Cells(r, 1) = .Cells(rg.Row, 1)
      End If
      r = r + 1
    Loop
  End With
  If Not NoFound Is Nothing Then
    NoFound.Select
    MsgBox NoFound.Address, vbOKOnly, "Не найдено шт.: " & NoFound.Cells.Count & ". Они отмечены можно их скопировать, удалить, залить цветом и пр."
  End If
End Sub

замены производятся ТОЛЬКО для значений из 1-й колонки редактируемого файла.

Кудесник! Поклон тебе до земли, походу работает. Один вопрос, если увеличу кол-во столбцов с синонимами, код надо править?

[Morozeckiy]

Сообщение от Hugo121

Думаю алгоритм может быть таким - цикл по эталонам, заносим в словарь синонимы как ключи, как item - правильное название.
Далее цикл по обрабатываемым данным - если нашли в словаре, то заменяем на item. Очень быстро, если данных много - обрабатывайте всё через массивы.
Если бы был пример в файле - был бы пример в коде.
Теперь уже поздно...

Как вариант - без всяких синонимов:
цикл по эталонам, в каждом удаляем пробелы/точки/тире, заменяем кириллицу на латиницу (на всякий пожарный), записываем получившееся как ключ в словарь, как итем пишем эталон.
Далее цикл по обрабатываемым данным - аналогично стараемся получить ключ, если есть в словаре - меняем на эталон из словаря.
Сравнение в словаре ставим текстовое - чтоб не мешал регистр. Ну или можно все ключи свести к одному регистру.
Такой подход исправит всё, кроме пары Dr.Pepper-Pepper. Да это вообще разные ведь вещи - человек и специя, их нельзя путать!

Спасибо за совет, этот способ тоже попробую. Кстати, названия другие, это я для простоты понимания)

[IgorGO]

количество столбцов с синонимами ограничено только размерами листа (количеством столбцов на листе)
все условия, которые следует соблюсти описаны в п.п.1...4 и п.5. без номера после кода написан

и, кстати, слова которые не нашлись, после работы макроса отмечены, их легко сразу скопировать и ручками раскидать по нужным строкам в файле эталон
следующий запуск макроса и их приведет к нормальному виду

[Morozeckiy]

Сообщение от IgorGO

количество столбцов с синонимами ограничено только размерами листа (количеством столбцов на листе)
все условия, которые следует соблюсти описаны в п.п.1...4 и п.5. без номера после кода написан

и, кстати, слова которые не нашлись, после работы макроса отмечены, их легко сразу скопировать и ручками раскидать по нужным строкам в файле эталон
следующий запуск макроса и их приведет к нормальному виду

Да, уже юзаю и правлю. Не сразу понял, как выделяет, тыкал на лист и сбрасывал выделения.