Добрый день. Есть такая задача, надо значения которые в колонке А:А найти в колонке D:D и найдя скопировать цены соответствующие названию. Названия в колонке А:А могут повторятся, значит поиск должет осуществлятся дважды. Но проблема в том что, если в колонке А:А есть занчение которого нет в D:D то тогда вылетает Error, а надо чтоб он автоматически переходил к поиску следующей ячейки в колоне А:А , а эту в B:B оставил пустой(в моём варианте ячейка B9). Пробовал через If.. Then... , но что-то не получается. Искал в поиске но никак не могу подобрать мне нужный вариант.
Писал ' On Error Resume Next , но тогда он копирует последнее найденное значение а не оставляет ячейку пустой
Подсобите, направте в нужном направлении.
Спасибо за ранее
Добрый день. Есть такая задача, надо значения которые в колонке А:А найти в колонке D:D и найдя скопировать цены соответствующие названию. Названия в колонке А:А могут повторятся, значит поиск должет осуществлятся дважды. Но проблема в том что, если в колонке А:А есть занчение которого нет в D:D то тогда вылетает Error, а надо чтоб он автоматически переходил к поиску следующей ячейки в колоне А:А , а эту в B:B оставил пустой(в моём варианте ячейка B9). Пробовал через If.. Then... , но что-то не получается. Искал в поиске но никак не могу подобрать мне нужный вариант.
Писал ' On Error Resume Next , но тогда он копирует последнее найденное значение а не оставляет ячейку пустой
Вообще-то конкретно здесь достаточно записать рекордером "протяжку" корректной ВПР() (с обработкой ошибки), затем замена формул на значения - получите готовый макрос. А в теории (и для большого количества данных) нужно делать на массивах и словаре - поищите коды по сочетанию scripting.dictionary - подойдёт любой.
И никаких .Select - это лишнее.
Вообще-то конкретно здесь достаточно записать рекордером "протяжку" корректной ВПР() (с обработкой ошибки), затем замена формул на значения - получите готовый макрос. А в теории (и для большого количества данных) нужно делать на массивах и словаре - поищите коды по сочетанию scripting.dictionary - подойдёт любой.
Знал бы как в ручную записать поиск сделал бы .... А про эту функцию scripting.dictionary почитаю, может что и получится ... Просто в колонне А:A у меня 1000 значений а в D:D 10 000 и все они не по алфавиту . По алфавиту не могу так как копирую их с дугих документов, нахожу цены и потом копирую обратно..
Hugo, Спасибо за ответ.
Знал бы как в ручную записать поиск сделал бы .... А про эту функцию scripting.dictionary почитаю, может что и получится ... Просто в колонне А:A у меня 1000 значений а в D:D 10 000 и все они не по алфавиту . По алфавиту не могу так как копирую их с дугих документов, нахожу цены и потом копирую обратно..Andrej092
Ладно, по ВПР() мы друг друга не поняли, но всёж на такое соотношение количества данных думаю вполне применимо ВПР() Вот, записал рекордером на доработку:
[vba]
Код
Sub zapuskatelj() Macro1 Macro2 Macro3 End Sub
Sub Macro1() Range("B3").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],C[2]:C[3],2,0)" Selection.AutoFill Destination:=Range("B3:B16") Range("B3:B16").Select End Sub Sub Macro2() Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub Sub Macro3() Selection.SpecialCells(xlCellTypeConstants, 16).Select Application.CutCopyMode = False Selection.ClearContents End Sub
[/vba] Поубирать все селкшены, мельтешение экрана...
А с поиском нужно примерно так работать (отвлечённый пример):
[vba]
Код
Sub tt() Dim x As Range Set x = Columns(1).Find("что ищем", , xlValues, xlWhole) If Not x Is Nothing Then Range([a1], x.Offset(-1)).EntireRow.Delete End Sub
[/vba]
Ладно, по ВПР() мы друг друга не поняли, но всёж на такое соотношение количества данных думаю вполне применимо ВПР() Вот, записал рекордером на доработку:
[vba]
Код
Sub zapuskatelj() Macro1 Macro2 Macro3 End Sub
Sub Macro1() Range("B3").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],C[2]:C[3],2,0)" Selection.AutoFill Destination:=Range("B3:B16") Range("B3:B16").Select End Sub Sub Macro2() Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub Sub Macro3() Selection.SpecialCells(xlCellTypeConstants, 16).Select Application.CutCopyMode = False Selection.ClearContents End Sub
[/vba] Поубирать все селкшены, мельтешение экрана...
А с поиском нужно примерно так работать (отвлечённый пример):
[vba]
Код
Sub tt() Dim x As Range Set x = Columns(1).Find("что ищем", , xlValues, xlWhole) If Not x Is Nothing Then Range([a1], x.Offset(-1)).EntireRow.Delete End Sub
ВПР я записал без макроса ... Но ваш макрос сокращает время работы... просто можно поменять диапозон и он подходит и вдругих случаях. А с функцией Find надо разобраться мне ...
P.S. Но мой макрос с мельтешением мне даже понравился, видно что он трудится в поте лица и пытается выполнить поставленую перед ним здачу
Hugo, Спасибо :hands: ,
ВПР я записал без макроса ... Но ваш макрос сокращает время работы... просто можно поменять диапозон и он подходит и вдругих случаях. А с функцией Find надо разобраться мне ...
P.S. Но мой макрос с мельтешением мне даже понравился, видно что он трудится в поте лица и пытается выполнить поставленую перед ним здачу Andrej092
:)
Сообщение отредактировал Andrej092 - Среда, 26.02.2014, 14:45