vplookup или find ??

[sn00p]

всем дня доброго!
задача тривиальная - есть 2 таблици, на 2х листах.
в обеих есть т.н. ключевое поле - артикул. необходимо в 1й таблице подставить значения цены и кол-ва из второй таблицы соответственно артикулу.
как решаю?
у меня 2 варианта
работаем через find или через vplookup

'для кол-ва
For i = 1 To UBound(sekkk, 1)
    With Worksheets("ñëè÷èòåëüíàÿ").Range("b1:b" & nLastrow2)
        .Find(What:=sekkk(i, 2)).Activate
    End With
    ActiveSheet.Range("f" & Selection.Row) = sekkk(i, 3)
Next

nLastrow = iHowStr("öåíûSAP")

sekkk2 = ActiveWorkbook.Worksheets("öåíûSAP").Range("b7:d" & nLastrow)
'для цен
For i = 1 To UBound(sekkk2, 1)
    With Worksheets("ñëè÷èòåëüíàÿ").Range("b1:b" & nLastrow2)
        .Find(What:=sekkk2(i, 1)).Activate
    End With
    ActiveSheet.Range("e" & Selection.Row) = sekkk2(i, 3)
Next

и

For i = 2 To UBound(sekkk2, 1)
    nRowNum = nRowNum + 1
    mmmmm = sekkk2(i, 2)
    sekkk2(i, 2) = Application.IfError(Application.VLookup(mmmmm, sekkk, 2, False), 0)
    'ActiveSheet.Range("f" & i) = Application.IfError(zzzzz, 0)
 DoEvents

Next

ActiveWorkbook.Worksheets("ñëè÷èòåëüíàÿ").Range("a1").Resize(nRowNum, UBound(sekkk2, 2)).Value = sekkk2

1я версия работает боле менее сносно, если учесть, что в одной таблице 17к строк в другой 12 - она ее крутит 2+1\2 минуты, но постоянно с функцией find лезут грабли, типа валится вот такая ошибка
Object variable or With block variable not set
но по коду нет ни того ни другого, да и ошибка какая то фантомная, причем возникает всегда во втором блоке, который делает замену по ценам, хотя они идентичны! научите юзать find!! пожалуйста!

2я версия, где vplookup в полный рост - вообзе никогда не заканчивается, вернее ждал 5 минут и бросал это дело!))
товарищи - научите уму разуму)

[IgorGO]

Вашу же процедуру еще и запускать надо время от времени, надо еще решить когда..., а просто формулу написать в две колонки? ВПР(...
и данные постоянно актуальны, и не исключаю, что будет быстрее работать.

[Hugo121]

Если в данных нет формул (ибо они затрутся) я бы сделал на массивах:
(в детали не вник, поэтому мысль в общем)
1. берём оба диапазона в массивы
2. циклом перебираем оба, заменяем в одном или обоих значения
3. выгружаем данные назад

17*12к обработает за пару секунд.
А с Find надо предусмотреть, что делать, если не нашлось. И никаких Activate - это только тормозит.
В общем, я бы сделал на массивах, или переписал заново с Find, если в той области есть формулы.

[sn00p]

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

Вашу же процедуру еще и запускать надо время от времени, надо еще решить когда..., а просто формулу написать в две колонки? ВПР(...
и данные постоянно актуальны, и не исключаю, что будет быстрее работать.

это самы простой вариант, а что будет при открытии файла? он будете пересчитываться)

с массивами дела, как то очень долгло.
а без Activate - вернет позицию найденного?строку.?

[Hugo121]

VBA массивы - это очень быстро. Быстрее, чем ADO...
Пример по поиску:

Set Found = Cells.Find("вот_такой_текст", lookAt:=xlWhole) 
If Not TypeName(Found) = "Nothing" Then ' Можно заменить конструкцией If Not Found Is Nothing Then 
     ' Точка входа найдена, удаляем 
     Rows(Found.Row & ":" & Cells.SpecialCells(xlLastCell).Row).Delete 
End If

Можно использовать Found.Row, Found.Column, Found.Address
Вместо Found можно использовать любую переменную, тип Range.

[EugeneS]

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

всем дня доброго!
задача тривиальная - есть 2 таблици, на 2х листах.
в обеих есть т.н. ключевое поле - артикул. необходимо в 1й таблице подставить значения цены и кол-ва из второй таблицы соответственно артикулу.

Подобная задача может быть решена с помощью библиотеки ADO, см. вложение. Скорость обработки практически не зависит от объема данных. Предварительно необходимо подключить данну библиотеку: Сервис - Редактор Visual Basic - Tools - References - установите птичку напротив Microsoft ActiveX Data Objects 2.0 Library - OK. Нажмите "Выполнить". Результат: Лист3

[Hugo121]

И тот же результат на массивах:

Sub PriceArr()
Dim a(), b()
Dim i As Long, ii As Long

a = Sheets(1).Range("a2:c" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Value
b = Sheets(2).Range("a2:c" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value

For i = 1 To UBound(a)
For ii = 1 To UBound(b)
If b(ii, 1) = a(i, 1) Then b(ii, 2) = a(i, 2): b(ii, 3) = a(i, 3): Exit For
Next ii, i
Sheets(2).Range("a2:c" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value = b
End Sub

Если сделать данных тысяч на 20, то можно и скорость померить.

P.S.Померил -в 3 раза массивы медленнее на таком переборе оказались...
Даже на чуть более быстром коде:

Sub PriceArr()
Dim tm
tm = Timer
Dim a(), b(), c()
Dim i As Long, ii As Long

a = Sheets(1).Range("a2:c" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Value
b = Sheets(2).Range("a2:a" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value
ReDim c(1 To UBound(b), 1 To 2)
For i = 1 To UBound(a)
For ii = 1 To UBound(b)
If b(ii, 1) = a(i, 1) Then c(ii, 1) = a(i, 2): c(ii, 2) = a(i, 3): Exit For
Next ii, i
Sheets(2).Range("b2:c" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value = c
Debug.Print Timer - tm
End Sub

[sn00p]

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

И никаких Activate - это только тормозит.

Worksheets("ñëè÷èòåëüíàÿ").Range("b 1:b" & nLastrow2).Find(What:=sekkk(i, 2))

вызывает ошибку:
compile error :
excepted :=

[Hugo121]

set x = Worksheets("ñëè÷èòåëüíàÿ").Range("b 1:b" & nLastrow2).Find(What:=sekkk(i, 2))

попробуйте так.
Опробовал, работает:

Sub rr()
Dim sekkk(1 To 2, 1 To 2)
Dim i
i = 1
sekkk(i, 2) = "tt"
nLastrow2 = 10
Set x = Worksheets("Лист2").Range("b1:b" & nLastrow2).Find(What:=sekkk(i, 2))
If Not x Is Nothing Then MsgBox x.Row Else MsgBox "Not Find!"
End Sub

[sn00p]

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

И тот же результат на массивах:

Sub PriceArr()
Dim a(), b()
Dim i As Long, ii As Long

a = Sheets(1).Range("a2:c" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Value
b = Sheets(2).Range("a2:c" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value

For i = 1 To UBound(a)
For ii = 1 To UBound(b)
If b(ii, 1) = a(i, 1) Then b(ii, 2) = a(i, 2): b(ii, 3) = a(i, 3): Exit For
Next ii, i
Sheets(2).Range("a2:c" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value = b
End Sub

Если сделать данных тысяч на 20, то можно и скорость померить.

P.S.Померил -в 3 раза массивы медленнее на таком переборе оказались...
Даже на чуть более быстром коде:

Sub PriceArr()
Dim tm
tm = Timer
Dim a(), b(), c()
Dim i As Long, ii As Long

a = Sheets(1).Range("a2:c" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Value
b = Sheets(2).Range("a2:a" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value
ReDim c(1 To UBound(b), 1 To 2)
For i = 1 To UBound(a)
For ii = 1 To UBound(b)
If b(ii, 1) = a(i, 1) Then c(ii, 1) = a(i, 2): c(ii, 2) = a(i, 3): Exit For
Next ii, i
Sheets(2).Range("b2:c" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value = c
Debug.Print Timer - tm
End Sub

попробую вариант с перебором простым