Сообщество Чайников

Вопрос

Нужно из двух(многих) файлов(прайсов) произвести выборку позиций и объединить их в один файл:

1. Названия позиций повторяются и нужно если позиция была в первом файле из всех остальных брать только цены и подставлять в соответствующую строку.

2. Цены и упаковку надо подставлять в разные колонки(для каждого прайса своя) но строки с названиями позиций не должны повторяться.

В общем:
в новом листе 1-я колонка название товара
2-я колонка упаковка
3-я,н-я колонка цена на товар по каждой фирме

Понимаю что надо писать макрос, или как-то играться с аксессом(БД), но я как бы чайник, поэтому, если у кого есть готовое решение или какие идеи — милости просим!

Ответ

Если, конечно, я правильно понял задачу…

Public Sub AllToOne()
Dim i, j, cc, nr As Integer 'создать новую книгу с одним листом
Set nw = Workbooks.Add(xlWBATWorksheet)
Set ns = nw.ActiveSheet
Set af = Application.WorksheetFunction On Error Resume Next c = 2 g = 1 'цикл по всем книгам кроме новой
For i = 1 To Workbooks.Count — 1 If Workbooks(i)
.Name <> "Personal.xls" Then 'цикл по всем листам текущей книги
For j = 1 To Workbooks(i)
.Worksheets.Count Set cs = Workbooks(i)
.Worksheets(j) 'перенести заголовки текущ.листа в новую книгу
If c = 2 Then ns.Cells(1, 1) = cs.Cells(1, 1)
ns.Cells(1, 2) = cs.Cells(1, 2)
End If c = c + 1 ns.Cells(1, c) = Workbooks(i)
.Name & ":" _ & Workbooks(i).Worksheets(j)
.Name & _ ":" & cs.Cells(1, 3) 'цикл по всем строкам текущ.листа nr = cs.Cells(1, 1)
.CurrentRegion.Rows.Count For n = 2 To nr 'перенести данные строки в новую книгу:
Err.Clear m = af.Match(cs.Cells(n, 1).Value, _ ns.Range("A:A"), False) 'если нет таких данных, то в новую строку
If Err.Number > 0 Then g = g + 1 ns.Cells(g, 1)
.Value = cs.Cells(n, 1)
.Value ns.Cells(g, 2)
.Value = cs.Cells(n, 2)
.Value ns.Cells(g, c)
.Value = cs.Cells(n, 3)
.Value Else 'если есть такие данные, то цену в ту же строку
ns.Cells(m, c)
.Value = cs.Cells(n, 3)
.Value End If 'конец цикла по строкам Next n 'конец цикла по листам Next j 'конец цикла по книгам
End If Next i
End
Sub

Программа просмотрит все листы всех открытых книг. Т.е. перед запуском макроса нужно открыть все книги с прайсами.

Из конференции Expert_FAQ