Поиск значений и копирование диапазона

[Samarator]

Добрый день мастера. Подскажите пожалуйста как решить проблему. Итак имеется книга в ней два листа "Прайс" и "Результат". На листе "Прайс" соответственно сам прайс, в диапазоне ячеек от A до H включительно то, что нужно копировать на лист "Результат" при положительном условии поиска. Столбец I копия столбца D т.к. при копировании диапазона макрос ругался и пришлось вынести копию столбца из диапазона но не суть, так вот, а столбец М это Данные со сканера и в принципе задача проста, берем данные со сканера и ищем каждое значение с тем что в прайсе и если есть совпадения по штрихкоду то копируем диапазон ячеек от A до H на лист "Результат". Так вот, но проблема вот в чем при сканировании или в прайсе иногда бывают нули впереди и естественно если стоит ноль впереди в прайсе а сканер отсканировал без нуля то совпадения уже нет и результат не попадает на лист Результат. Помогите решить эту проблему пожалуйста. Нули убирать нельзя, мысль такая была, но получается потом уже не точность и приходится сидеть и выверять ещё больше..... нужны точные значения на листе результат. Но получается что из за нуля или нулей впереди одна и та же позиция не попадает в результат. Я понимаю что нужно убрать нули в промежуточном сравнении а потом вставить оригинальный вариант но как это сделать.... в общем прошу помощи у мастеров. Заранее спасибо. Файл прилагаю. 

[RAN]

Работайте не с текстом, а с числами. Тогда лидирующие нули не страшны.

Код (vb) Выделить Развернуть

Sub OtborNew()
Dim lRow&, i&, ii&, t&, dictShtrih As Object, a()

   With Sheets("Результат")
       lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
       If lRow > 1 Then .Range("A1:H" & lRow).ClearContents
   End With

   With Sheets("Прайс")
       lRow = .Cells(.Rows.Count, "M").End(xlUp).Row

       If lRow = 1 Then Exit Sub

       Set dictShtrih = CreateObject("Scripting.Dictionary")
       a = .[m1].CurrentRegion.Value
       For i = 2 To lRow: dictShtrih.Item(Val(a(i, 1))) = a(i, 2): Next i

       lRow = .Cells(.Rows.Count, "B").End(xlUp).Row

       If lRow = 1 Then Exit Sub
       .Columns(3).NumberFormat = "general"
       a = .Range("B1:I" & lRow).Value
       t = UBound(a, 2) - 1: ii = 1
       For i = 2 To UBound(a)
           If dictShtrih.exists(Val(a(i, 8 ))) Then
               ii = ii + 1
               For x = 1 To t: a(ii, x) = a(i, x): Next
               a(ii, t + 1) = dictShtrih.Item(Val(a(i, 8 )))
           End If
       Next i
   End With

   Sheets("Результат").Range("B1").Resize(ii, t + 1) = a
End Sub

[Дмитрий Щербаков(The_Prist)]

Вероятно, так...

Код Выделить Развернуть

Sub OtborNew()
Dim lRow&, i&, ii&, t&, dictShtrih As Object, a()

    With Sheets("Результат")
        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        If lRow > 1 Then .Range("A1:H" & lRow).ClearContents
    End With

    With Sheets("Прайс")
        lRow = .Cells(.Rows.Count, "M").End(xlUp).Row

        If lRow = 1 Then Exit Sub

        Set dictShtrih = CreateObject("Scripting.Dictionary")
        a = .[m1].CurrentRegion.Value
        For i = 2 To lRow: dictShtrih.Item(Val(a(i, 1))) = a(i, 2): Next i

        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row

        If lRow = 1 Then Exit Sub
        .Columns(3).NumberFormat = "general"
        a = .Range("B1:I" & lRow).Value
        t = UBound(a, 2) - 1: ii = 1
        For i = 2 To UBound(a)
            If dictShtrih.exists(Val(a(i, 8))) Then
                ii = ii + 1
                For x = 1 To t: a(ii, x) = a(i, x): Next
                a(ii, t + 1) = dictShtrih.Item(Val(a(i, 8)))
            End If
        Next i
    End With

    Sheets("Результат").Range("B1").Resize(ii, t + 1) = a
End Sub