Excel -скрипт сравнения двух файлов и копирования данных из одного в другой

[Snake_]

Народ!помогите плиз написать скрипт:
Есть 2 файла X и Y
В файле X есть 3 столбца: D(столбец с фамилиями),E(столбец с именами),F(столбец с отчеством),всего 1925 строк.
В файле Y есть 3 аналогичных столбца:A(столбец с фамилиями),B(столбец с именами),C(столбец с отчеством),всего 1842 строки
Необходимое условие сравнения - совпадение данных файлов X и Y (ФИО) во всех трех столбцах одной строки. Если совпадение происходит,то с файла Y происходит копирование данных соответствующей совпавшей строки:
1)содержимое столбца D файла Y копируется в столбец С файла X
2)содержимое столбца F файла Y копируется в столбец AF файла X
3)содержимое столбца H файла Y копируется в столбец AD файла X
4)содержимое столбца J файла Y копируется в столбец AC файла X

Заранее благодарен!

[doober]

будет файл-будет и скрипт.Тренироваться на чем?

[Snake_]

Скину начальные части файлов,остальное если нужно будет добавлю

[nilem]

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

3)содержимое столбца J файла Y копируется в столбец AC файла X

Вместо AC, наверное, должно быть AB (вроде, лишний столбец)?

[Snake_]

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

Вместо AC, наверное, должно быть AB (вроде, лишний столбец)?

нет,именно АС

[Hugo121]

Вот Вам инструмент: http://hugo.nxt.ru/CompareFiles.Find.rar , как раз для таких задач и делал.
В настройках пишите что сравнивать, куда копировать.

Да вот они, проверил, 17 совпадений:

Файл - приёмник: c:\Temp\Snake_\X.xls
Файл - источник: c:\Temp\Snake_\Y.xls
Столбцы сравнения в приёмнике: d,e,f
Столбцы сравнения в источнике: a,b,c
Лист - приёмник (№): 1
Лист - источник (№): 1
Столбцы - приёмники данных копирования: c,af,ad,ac
Столбцы - источники данных копирования: d,f,h,j

[nilem]

Давайте попробуем без массивов, словарей и пр.

PHP код:

Option Explicit
Option Compare Text

Sub UpdateRecords()
Dim wb As Workbook
Dim i As Integer, j As Integer, k As Integer
Dim LRx As Integer, LRy As Integer
'Dim tm As Single
'tm = Timer
Application.ScreenUpdating = False

Set wb = GetObject(ThisWorkbook.Path & "\Y.xls")
With wb.Sheets("SPISOK")
LRx = Cells(Rows.Count, 4).End(xlUp).Row
LRy = .Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LRx
    For j = 2 To LRy
        If Cells(i, 4) = .Cells(j, 1) And _
                Cells(i, 5) = .Cells(j, 2) And _
                        Cells(i, 6) = .Cells(j, 3) Then
        Cells(i, 3) = .Cells(j, 4): Cells(i, 32) = .Cells(j, 6)
        Cells(i, 30) = .Cells(j, 8): Cells(i, 29) = .Cells(j, 10)
        k = k + 1: Exit For
        End If
    Next j: Next i
End With
wb.Close False
Application.ScreenUpdating = True
'MsgBox Timer - tm
MsgBox "Обновлено записей: " & k, vbInformation, "Обновление"
End Sub 


Оба файла должны быть в одной папке. Запускаем из файла Х по зеленой стрелке.
P.S. По 2000 строк в обоих файлах - затрачено 3,09 сек.

[VictorM]

Вот Вам инструмент

Ошибка, запрещеная закачка...
Что не так?

[Hugo121]

Заходите браузером - там промежуточное звено - почтовый сервер.

Т.е. копируйте ссылку в адресную строку.

[VictorM]

Hugo121
Спасибо, забрал кое-как и только через ИЕ ))
Посмотрим, что за "зверь"
p.s.
А почему бы Вам не прикрепить Ваш файлик прямо к сообщению, было бы намного проще.