Вот как сделал я:
1. Создаю кнопку на листе, в котором следует заменить идентификаторы на их наименования, на кнопку вешаю код, приведенный ниже.
2. В отдельном файле TITS.XLS имеем таблицу на 2 столбца: 1 - идентификатор, по которому собственно ведется поиск, 2 - наименование, которое нужно выудить по идентификатору.
3. Открываем рабочий лист, в цикле обрабатываем каждое значение идентификатора, по нему с помощью FIND ищем наименование:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
Sub ЗаполнитьТиты()
Dim titID As String ' идентификатор
Dim titName As String ' наименование
Dim i As Integer, _
j As Integer, _
k As Integer, _
l As Integer ' счетчики
Dim rn As Range
Dim firstAddress As String
Dim xla As Excel.Application
Dim xlw As Excel.Workbook ' объект рабочей книги
Dim xls As Excel.Worksheet ' объект рабочего листа
i = 2 ' начальная строка парсинга
Set xla = New Excel.Application
xla.Workbooks.Add Template:=xla.DefaultFilePath + "/tits.xls"
' создание нового объекта Exel Workbook
Set xlw = xla.Workbooks( 1 )
' создание ссылки на текущий рабочий лист
Set xls = xlw.ActiveSheet
OIK.Activate
While (titID <> "XEND") And (titID <> " ") ' перебираем все идентификаторы до конца
titID = OIK.Cells(i, 1 )
With xls.Range("a1:a1110")
Set rn = .Find(titID, LookIn:=xlValues)
If Not rn Is Nothing Then
k = rn.Cells.Row
l = rn.Cells.Column
titName = xls.Cells(k, l + 1 ) ' наименование в соседней ячейке
End If
End With
OIK.Cells(i, 1 ) = titName
i = i + 1 ' на следующую строку
Wend
Set xls = Nothing
Set xlw = Nothing
Set xla = Nothing
End Sub
Работает достаточно быстро.
Одны проблема - неудобно переносить этот код и кнопку во множество файлов:-(
