Всем здравствуйте, подскажите, пожалуйста, как сделать так, чтобы макросом производился поиск позиций с первого листа в столбце А и если совпадающие позиции есть на листе2 рядом с ними подставлялись значения с соседней ячейки. Например, если на листе1 есть позиция Картофель, который равен 73 и на листе 2 в столбце B или D есть такая позиция, то рядом с ней подставлялось значение 73
Всем здравствуйте, подскажите, пожалуйста, как сделать так, чтобы макросом производился поиск позиций с первого листа в столбце А и если совпадающие позиции есть на листе2 рядом с ними подставлялись значения с соседней ячейки. Например, если на листе1 есть позиция Картофель, который равен 73 и на листе 2 в столбце B или D есть такая позиция, то рядом с ней подставлялось значение 73benza89
Sub d() Dim arr() As Variant Dim r As Range Set r = Parent.Sheets("Лист1").UsedRange With Me.UsedRange.Columns("B:E") arr = .Value For i = 1 To UBound(arr) For j = 2 To UBound(arr, 2) Step 2 With Application arr(i, j) = .IfError(.VLookup(arr(i, j - 1), r, 3, 0), "") End With Next Next .Value = arr End With End Sub
[/vba] до кучи в обратную сторону [vba]
Код
Sub d() Dim arr() As Variant Dim rng As Range Set rng = Parent.Sheets("Лист2").UsedRange With Me.UsedRange.Columns("A:C") arr = .Value For i = 1 To UBound(arr) Set r = rng.Find(arr(i, 1), , xlValues, xlWhole, , , False, , False) If Not r Is Nothing Then arr(i, 3) = r.Offset(, 1).Value Next .Value = arr End With End Sub
Sub d() Dim arr() As Variant Dim r As Range Set r = Parent.Sheets("Лист1").UsedRange With Me.UsedRange.Columns("B:E") arr = .Value For i = 1 To UBound(arr) For j = 2 To UBound(arr, 2) Step 2 With Application arr(i, j) = .IfError(.VLookup(arr(i, j - 1), r, 3, 0), "") End With Next Next .Value = arr End With End Sub
[/vba] до кучи в обратную сторону [vba]
Код
Sub d() Dim arr() As Variant Dim rng As Range Set rng = Parent.Sheets("Лист2").UsedRange With Me.UsedRange.Columns("A:C") arr = .Value For i = 1 To UBound(arr) Set r = rng.Find(arr(i, 1), , xlValues, xlWhole, , , False, , False) If Not r Is Nothing Then arr(i, 3) = r.Offset(, 1).Value Next .Value = arr End With End Sub
krosav4ig, к сожалению выдает ошибку "invalid use of me keyword", ругается на "Me.UsedRange.Columns("B:E")" Поменяла на Sheets("Лист2").Range("B2:E200") всё работает и быстро, спасибо Вам преогромнейшее за макрос!
krosav4ig, к сожалению выдает ошибку "invalid use of me keyword", ругается на "Me.UsedRange.Columns("B:E")" Поменяла на Sheets("Лист2").Range("B2:E200") всё работает и быстро, спасибо Вам преогромнейшее за макрос!benza89
Сообщение отредактировал benza89 - Понедельник, 18.02.2019, 16:46