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
Поиск и копирование значения
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 прописать найденную ячейку, не знаю.
Не вполне ясен смысл этой фразы. Однако может быть Вам надо что-то такое: [color=blue]ActiveCell.Offset(0, 2).Value = ActiveCell.Value[/color]
ActiveCell - это текущая ячейка.
ActiveCell.Offset(0, 2) - это ячейка, смещённая относительно текущей на 2 столбца вправо.
Nik_221, Вот пример, который позволит Вам получить и найденную ячейку (конечно, только в случае наличия искомого значения в столбце "A") и ячейку, расположенную в столбце "C".
Как смог, разобрался, и сори за возможно некорректный вопрос, но главное что теперь буду дальше пытаться.
И в дагонку еще один вопрос.
Мне необходимо найти ряд значений типа 4122, 4029, 4087, 3897,4197 и тд (они заранее известны), если значение найденно, то скопировать из столбца D значение в буфер и поставить в другой книге, в определенную ячейку, но возможно какого-то значения нет, тогда чтобы продолжался поиск следующих значений, без вывода об ошибки.
Код:
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
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