Сравнить 2 файла Excel - VBA

Узнай цену своей работы

Формулировка задачи:

Привет всем! Очень нужна помощь.. Нужно сравнить 2 файла Excel по столбцу. 1 Найти одинаковые данные в столбце, 2 Данные которые есть в первом документе, но нет во втором 3 Данные которые есть во втором, нот нет в первом 4 Записать результаты на отдельные листы. Помогите пожалуйста, очень надо.... Заранее спасибо

Решение задачи: «Сравнить 2 файла Excel»

textual
Листинг программы
Sub QWERT()
Dim Q As Object
Dim W As Object
Dim Qb As Workbook
Dim Wb As Workbook
Dim Sq
Dim Sw
Dim Mq()
Dim Mw()
Dim R1, R2
Dim S1, S2, S3
'открываем книги
Set Qb = Workbooks.Open(Filename:="C:\Книга2.xls")
Set Wb = Workbooks.Open(Filename:="C:\Книга3.xls")
'определяем количество строк
Sq = Qb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Sw = Wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'считываем в массив
Mq = Qb.Application.Range(Cells(1, 1), Cells(Sq, 1)).Value
Mw = Wb.Application.Range(Cells(1, 1), Cells(Sw, 1))
'загоняем в словари
Set Q = CreateObject("Scripting.Dictionary")
Set W = CreateObject("Scripting.Dictionary")
 
For R1 = 1 To Sq
If Not Q.Exists(Mq(R1, 1)) Then Q.Add Mq(R1, 1), 1
Next R1
 
For R1 = 1 To Sw
If Not W.Exists(Mw(R1, 1)) Then W.Add Mw(R1, 1), 1
Next R1
 
For R1 = 1 To Sq
        If W.Exists(Mq(R1, 1)) Then 'если есть
        S1 = S1 + 1
        Лист2.Cells(S1, 1) = Mq(R1, 1)
        Else 'в противном случае
        S2 = S2 + 1
        Лист3.Cells(S2, 1) = Mq(R1, 1)
        End If
Next R1
S1 = 0
S2 = 0
For R1 = 1 To Sw
        If Q.Exists(Mw(R1, 1)) Then 'если есть
        S1 = S1 + 1
        Лист4.Cells(S1, 1) = Mw(R1, 1)
        Else 'в противном случае
        S2 = S2 + 1
        Лист5.Cells(S2, 1) = Mw(R1, 1)
        End If
Next R1
 
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 3.867 из 5
Похожие ответы