Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

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

20K
27 октября 2006 года
Nik_221
4 / / 11.10.2006
Помогите, плиз, я только начинаю осваивать макросы, задачка в следующем: необходимо найти определеное значение в столбце А, затем сместится в найденной строке на две ячейки (столбец С), скопировать оттуда значение. Как найти я понял:

Sub obrabotka()

Dim lRow As Long

lRow = Cells.Find(What:="4122", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

А вот как для Range прописать найденную ячейку, не знаю.
405
27 октября 2006 года
Dmitrii
554 / / 16.12.2004
[QUOTE=Nik_221]А вот как для Range прописать найденную ячейку, не знаю.[/QUOTE]
Не вполне ясен смысл этой фразы. Однако может быть Вам надо что-то такое: [color=blue]ActiveCell.Offset(0, 2).Value = ActiveCell.Value[/color]
ActiveCell - это текущая ячейка.
ActiveCell.Offset(0, 2) - это ячейка, смещённая относительно текущей на 2 столбца вправо.
275
27 октября 2006 года
pashulka
985 / / 19.09.2004
Nik_221, Вот пример, который позволит Вам получить и найденную ячейку (конечно, только в случае наличия искомого значения в столбце "A") и ячейку, расположенную в столбце "C".

Код:
Private Sub Obrabotka()

Dim iCell As Range

If TypeOf ActiveSheet Is Worksheet Then
   Set iCell = ActiveSheet.Columns(1).Find( _
   What:="4122", LookIn:=xlValues, LookAt:=xlWhole) 'LookIn:=xlFormulas, LookAt:=xlPart
   If Not iCell Is Nothing Then
      MsgBox "Адрес найденной ячейки : " & iCell.Address, , ""
      MsgBox "Адрес ячейки в столбце ""C"" : " & iCell(1, 3).Address, , "Var1"
      MsgBox "Адрес ячейки в столбце ""C"" : " & iCell.Item(1, 3).Address, , "Var1"
      MsgBox "Адрес ячейки в столбце ""C"" : " & iCell.Cells(1, 3).Address, , "Var3"
      'Если копирование необходимо, например, из-за параметров форматирования, то
      iCell.Item(1, 3).Copy Destination:=iCell.Item(1, 4) 'для примера копируем в столбец "D"
   Else
      MsgBox "К сожалению, точного соответствия найдено не было", , ""
   End If
End If

End Sub
20K
27 октября 2006 года
Nik_221
4 / / 11.10.2006
СПАСИБО, pashulka!!!
Как смог, разобрался, и сори за возможно некорректный вопрос, но главное что теперь буду дальше пытаться.

И в дагонку еще один вопрос.
Мне необходимо найти ряд значений типа 4122, 4029, 4087, 3897,4197 и тд (они заранее известны), если значение найденно, то скопировать из столбца D значение в буфер и поставить в другой книге, в определенную ячейку, но возможно какого-то значения нет, тогда чтобы продолжался поиск следующих значений, без вывода об ошибки.
275
27 октября 2006 года
pashulka
985 / / 19.09.2004
Код:
Private Sub Obrabotka()

Dim iSource As Worksheet, iDestination As Worksheet, iCell As Range

If TypeOf ActiveSheet Is Worksheet Then
   
   Application.ScreenUpdating = False
   
   Set iSource = ActiveSheet
   'Если есть возможность, то можно использовать полную ссылку, т.е.
   'Workbook.Worksheet.Column.Find и обойтись без переменной и проверки (см. выше)
   Set iDestination = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
   'Используется исключительно в качестве примера (для имитации второй книги)
   'В Вашем случае, это будет ссылка на существующую и открытую книгу + лист
   
   For Each iItem In Array("4122", "4029", "4087", "3897", "4197")
       Set iCell = iSource.Columns(1).Find(What:=iItem, LookIn:=xlValues, LookAt:=xlWhole)
       If Not iCell Is Nothing Then
          'Довольствуемся первым найденным значение.
          'Для поиска всех значений, нужно добавить ещё FindNext
          iRow& = iRow& + 1
          iCell.Item(1, 4).Copy Destination:=iDestination.Cells(iRow&, 1)
          iDestination.Cells(iRow&, 2).Value = iCell.Item(1, 4).Value
          'Для примера используем столбец "A" и "B" (новая книга)
       End If
   Next
   
   Application.ScreenUpdating = True
   
End If

End Sub
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог