Сравнение столбцов Exel

[lirik88]

Добрый день!
Помогите написать скрипт сравнения сталбцов, ибо в Exel я полный ноль.В прилогаемом файле есть 2 листа подготовка и импорт в ГДП, в листе импорт в ГДП есть перечень тэгов с описанием и размерностью(столбец B и C) которые соответствуют каждому тэгу. В листе подготовка есть перечень необходиммых тэгов(часть тэгов из листа импорт в ГДП) в столбце B , необходимо взять данные о каждом тэге(столбец В и С на листе импорт в ГДП) и присвоить эти данные тэгам в столбцы С(описание сигнала) и D(размерность).

[Hugo121]

Попробуйте сделать макросом из
http://hugo.nxt.ru/CompareFiles.Find.rar

Настройки под Ваш пример:

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


Делает небыстро, но пока я писал этот текст - сделалось (6800 совпадений)
Можно ещё дополнительно поставить пометки у найденных, чтоб картина была яснее

15 попыток free...

[Hugo121]

Или вот индивидуальный бесплатный код именно под эту задачу - очень быстро (0,98 сек. на небыстрой машине), но только под эту задачу...

Option Explicit

'Макросом -
'1.два диапазона в два массива
'2.создание массива для результатов
'3.один перебор 9083 значений массива в словарь
'4.7011 проверок массива на наличие в словаре и заполнение данными массива результатов
'5.выгрузка результатов

Sub compare()
Dim a, b, c, iLastrow As Long, i As Long, temp$

'1.
With Sheet1 'используется кодовое имя
iLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
a = Range(.[C2], .Range("A" & iLastrow)).Value
End With

With Sheet2 'используется кодовое имя
iLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
b = Range(.[B2], .Range("B" & iLastrow)).Value
End With


'2.
ReDim c(1 To UBound(b), 1 To 2)

'3.
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
            .Item(a(i, 1)) = CStr(i)
    Next

'4.
    For i = 1 To UBound(b)
    temp = b(i, 1)
      If .exists(temp) Then c(i, 1) = a(.Item(temp), 2): c(i, 2) = a(.Item(temp), 3)
    Next
End With

'5.
Sheet2.[C2:D2].Resize(i - 1) = c

End Sub

Результаты обоих кодов (сравнивал формулами) совпадают.

[lirik88]

Спасибо, все решилось простиньким скриптом
Sub Find_Matches()

Dim r As Range
Dim y As Long

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Worksheets(6)
For i = 2 To 7012
With ws.Range("a2:a9084")
Set r = .Find(ws.Cells(i, 6), LookIn:=xlValues)
If Not r Is Nothing Then
y = r.Row
ws.Cells(i, 7) = Cells(y, 2)
ws.Cells(i, 8) = Cells(y, 3)
End If
End With
Next
End Sub

предварительно данные обеденил в 1 лист для удоства итоговые значения передвались в 7 и 8 столбцы.

[Hugo121]

Ну если и сами можете - то советую второй скрипт посмотреть, ибо быстрый