Нужен макрос, объединяющий две таблицы в одну

[VectorC]

Здравствуйте!

Существует две таблицы с данными:

• Таблица Goods в которой хранятся товары.
• Таблица Costs в которой хранятся цены этих товаров.

Нужно связать эти две таблицы в одну, получив, тем самым таблицу, содержащую в себе как товары, так и их цены (разбиты по городам). В обеих таблица существует поле «Номенклатурный номер», по которому и предполагается связывать данные из исходных таблиц. Проще говоря, нужно получить таблицу Result, добавив в таблицу Goods последние четыре столбца из таблицы Costs, на основании эквивалентности поля «Номенклатурного номер».

Excel 2003
Файл с книгой прикрепил.

[Hugo121]

У Вас там косяк в номере 400019075...
Если последние 4, то отработал код из http://hugo.nxt.ru/CompareFiles.Find.rar
1146 совпадений.

Настройки:
Файл - приёмник: C:\temp\VectorC\Каталог.xls
Файл - источник: C:\temp\VectorC\Каталог.xls
Столбцы сравнения в приёмнике: a
Столбцы сравнения в источнике: a
Лист - приёмник (№): 1
Лист - источник (№): 2
Столбцы - приёмники данных копирования: O,P,Q,R
Столбцы - источники данных копирования: E,F,G,H

Добиваем первый лист данными второго. Можно сперва на лист Result скопировать данные первого листа и добивать туда.

[VectorC]

Спасибо, только у меня почему-то ничего не получилось.
Пишет:

Run-time error '438':

Object doesn't support this property or method

?

В чём косяк номера 400019075?

[Hugo121]

Жаль... Версия Экселя какая у Вас? У меня на 2000 и 2007 работает...
А косяк в том, что 400019075 два раза в таблице - один раз данных больше.

Хотя именно под эту задачу несложно макрос на массиве написать - вечером могу сделать, если раньше не напишут.

[Hugo121]

Уже. 2 секунды, без красивостей.

Option Explicit

Sub Result()

Dim a, b
Dim iLastrow As Long
Dim i As Long, ii As Long
'Dim tm
'tm = Timer

' Для ускорения работы макроса обновление экрана отключается.
Application.ScreenUpdating = False

With Sheets(" Goods ")
iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
a = Range(.Cells(1, 1), .Cells(iLastrow, 18)).Value
End With

With Sheets(" Costs ")
iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
b = Range(.Cells(1, 1), .Cells(iLastrow, 8)).Value
End With

For i = 1 To UBound(a)
For ii = 1 To UBound(b)
If a(i, 1) = b(ii, 1) Then
a(i, 15) = b(ii, 5)
a(i, 16) = b(ii, 6)
a(i, 17) = b(ii, 7)
a(i, 18) = b(ii, 8)
Exit For
End If
Next ii, i

Sheets(" Result ").Columns("E:E").NumberFormat = "@"


Sheets(" Result ").[A1].Resize(UBound(a, 1), UBound(a, 2)).Value = a    'выгружаем результат
Application.ScreenUpdating = True
'Debug.Print Timer - tm

End Sub

[shanemac51]

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

Жаль... Версия Экселя какая у Вас? У меня на 2000 и 2007 работает...
А косяк в том, что 400019075 два раза в таблице - один раз данных больше.

таких позиций 16
и 37 позиций --есть не во всех городах

[VectorC]

Спасибо Hugo121, всё получилось! Сделали с помощью последнего макроса.