макрос для слияния двух таблиц

[MrGB]

имеются 2 таблицы примерно 7 тысяч записей, содержащие 1 общий столбец(1ый). необходимо объединить таблицы по этому столбцу, учитывая, что одной записи первой таблицы может соответствовать несколько записей другой таблицы
Помогите советом как это делать! заранее спасибо

структура примерно такова:

Таблица1
1 | ABC | 2343
2 | CDE | 6574
3 | FGRT| 3465
4 | ABC | 2223
5 | ABC | 5676

Таблица2
1 | 343 | sad
1 | 232 | asd
2 | 123 | asd
3 | 233 | gre
4 | 222 | wer
4 | 676 | htt
4 | 123 | ewe
4 | 984 | etet
5 | 654 | vbf

[MrGB]

примеры файлов во вложении

[Hugo121]

Такой результат нужен? (к сожалению, output не открывается)

столбец1	столбец4	столбец5	столбец2	столбец3
1	234	sad	ABC	2343
1	544	asd	ABC	2343
2	654	asd	CDE	6574
3	346	gre	FGR	3465
4	764	wer	RGR	3231
4	543	tew	RGR	3231
4	343	qwe	RGR	3231
5	653	jyt	TYY	8752
5	546	wtr	TYY	8752

Получено файлом из http://hugo.nxt.ru/CompareFiles.Find.rar , настройки:

Файл - приёмник:	c:\Temp\MrGB\input2.xls
Файл - источник:	c:\Temp\MrGB\input1.xls
Столбцы сравнения в приёмнике:	a
Столбцы сравнения в источнике:	a
Лист - приёмник (№):	1
Лист - источник (№):	1
Столбцы - приёмники данных копирования:	d,e
Столбцы - источники данных копирования:	b,c

Нажать большую кнопку.

[EducatedFool]

А вот что у меня получилось:

Sub GroupFiles()
    On Error Resume Next:    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh2 = ActiveSheet
    Set sh1 = GetAnotherWorkbook.Worksheets(1)
    If Err Then Exit Sub

    sh2.Copy
    Dim sh As Worksheet: Set sh = ActiveSheet:    sh.Range("b:c").Insert
    Dim RangeForPaste As Range
    Set RangeForPaste = Range([A2], Range("A" & Rows.Count).End(xlUp)).Offset(, 1).Resize(, 2)
    'RangeForPaste.Interior.Color = vbGreen

    f = "=ВПР($A2;" & sh1.UsedRange.Address(, , , True) & ";СТОЛБЕЦ();0)"
    RangeForPaste.FormulaLocal = f
    RangeForPaste.Value = RangeForPaste.Value
End Sub

Функция GetAnotherWorkbook взята отсюда: http://excelvba.ru/code/GetAnotherWorkbook


Порядок работы:
1) подключаем эту надстройку к Excel (меню Сервис - Надстройки)

2) открываем файл 1.xls
3) открываем файл 2.xls (он отображается на экране в момент запуска макроса)

4) нажимаем комбинацию клавиш Ctrl + Shift + 9 для запуска макроса

[MrGB]

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

Такой результат нужен?

да именно такой, спасибо