Приветствую.
Что хочется. Есть 2 листа. ФИО и дата рождения с листа 1 ищутся на листе 2. Если таковые есть, то данные столбцов J,P,L листа 2 добавляются в столбцы FGH листа 1.
На текущий момент данные столбцов J,P,L листа 2 добавляются в столбец F листа 2. Никак не могу разбить найденное по столбцам, помогите плиз.
Словарь используется для ускорения работы, т.к. на каждом листе под полмиллиона строк.
Что хочется. Есть 2 листа. ФИО и дата рождения с листа 1 ищутся на листе 2. Если таковые есть, то данные столбцов J,P,L листа 2 добавляются в столбцы FGH листа 1.
На текущий момент данные столбцов J,P,L листа 2 добавляются в столбец F листа 2. Никак не могу разбить найденное по столбцам, помогите плиз.
Словарь используется для ускорения работы, т.к. на каждом листе под полмиллиона строк.
| Код |
|---|
Sub Search()
Dim a(), b(), t$, ii&, s$, i&, x&, ss$, d&, z&, Dict As Object, tt As Object
Dim w As Workbook, v As Worksheet ', vm As Worksheet
d = timeGetTime
Set vm = Sheets("1")
vm.Columns("F").ClearContents
For Each w In Application.Workbooks
If w.Name = "test.xlsm" Then
With w.Sheets("2")
ii = .Cells(.Rows.Count, 1).End(xlUp).Row
a = Range(.Cells(2, "F"), .Cells(ii, "S"))
End With
Exit For
End If
Next
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(a)
.Item(a(i, 1) & " " & a(i, 3)) = a(i, 5) & "|" & a(i, 11) & "|" & a(i, 7)
Next
vm.Activate
ii = Cells(Rows.Count, 2).End(xlUp).Row
a = Range("B2:C" & ii).Value
b = Range("F2:F" & ii).Value
For x = 2 To ii - 1
t = a(x, 1) & " " & a(x, 2)
If .Exists(t) Then
b(x, 1) = .Item(t)
End If
z = z + 1
Next x
End With
Range("F2:F" & ii).Value = b
End Sub
|
Изменено: - 02.12.2021 10:37:06
