Готовые макросы в VBA Excel, Миронов. Готовые макросы в vba excel, Миронов Глава Макросы 9

• Название: Готовые макросы в vba excel, Миронов Глава Макросы 9
• Дата: 23.01.2019
• Размер: 1.35 Mb.
• Имя файла: Готовые макросы в VBA Excel, Миронов.doc
• Тип: Документы; #64865
• страница: 17 из 47

Поиск с выделением найденных данных_2

Sub CustomSearch()

Dim strFindData As String

Dim rgFound As Range

Dim i As Integer

' Ввод строки для поиска

strFindData = InputBox("Введите данные для поиска")

' Просмотр всех рабочих листов книги

For i = 1 To Worksheets.Count

With Worksheets(i).Cells

' Поиск на i-м листе

Set rgFound = .Find(strFindData, LookIn:=xlValues)

If Not rgFound Is Nothing Then

' Ячейка с заданным значением найдена - выделим ее

Sheets(i).Select

rgFound.Select

Exit Sub

End If

End With

Next

' Поиск завершен. Ячейка не найдена

MsgBox ("Поиск не дал результатов")

End Sub

Поиск по условию в диапазоне

Option Explicit

Sub Поиск()

Dim iFoundRng As Range

Dim AutoNum As String

Dim firstAddress As String

Dim LastFoundRng As String

AutoNum = Range("E5")

If AutoNum = "" Then

MsgBox "Вы не указали номер авто в ячейке Е5!", 48, "Ошибка"

Exit Sub

End If

On Error Resume Next

LastFoundRng = ActiveWorkbook.Names("LastFoundRngName").RefersToRange.Address

If LastFoundRng = "" Then LastFoundRng = "$C$1"

With Columns("C")

Set iFoundRng = .Find(What:=AutoNum, After:=Range(LastFoundRng), LookIn:=xlFormulas, LookAt:=xlWhole)

If iFoundRng Is Nothing Then

MsgBox "Авто с номером " & AutoNum & " не найдено в столбце С!", "48", "Ошибка"

Exit Sub

End If

ActiveWorkbook.Names.Add Name:="LastFoundRngName", RefersTo:="=" & ActiveSheet.Name & "!" & iFoundRng.Address, Visible:=False

End With

[E7] = iFoundRng.Offset(0, 1)

[F7] = iFoundRng.Offset(0, 2)

End Sub

Поиск последней непустой ячейки диапазона

Function dhLastUsedCell(rgRange As Range) As Long

Dim lngCell As Long

' Пойдем по диапазону с конца (тогда первая попавшаяся _

заполненная ячейка и будет искомой)

For lngCell = rgRange.Count To 1 Step -1

If Not IsEmpty(rgRange(lngCell)) Then

' Нашли непустую ячейку

dhLastUsedCell = lngCell

Exit Function

End If

Next lngCell

' Непустую ячейку не нашли

dhLastUsedCell = 0

End Function

Поиск последней непустой ячейки столбца

Function dhLastColUsedCell(rgColumn As Range) As Variant

' Вывод значения последней непустой ячейки столбца

dhLastColUsedCell = rgColumn.Parent.Cells(Rows.Count, _

rgColumn.Column).End(xlUp).Value

End Function

Поиск последней непустой ячейки строки

Function dhLastRowUsedCell(rgRow As Range) As Variant

' Вывод значения последней непустой ячейки строки

dhLastRowUsedCell = rgRow.Parent.Cells(rgRow.Row, 256). _

End(xlToLeft).Address

End Function

Поиск ячейки синего цвета в диапазоне

Sub Макрос1()

Dim myRange As Range 'диапазон для поиска

Dim FoundRng As Range 'найденная ячейка

Dim iRow As Long

Dim iColumn As Long

Set myRange = Range("B1:B100")

Application.FindFormat.Interior.ColorIndex = 5 'будем искать синий цвет

Set FoundRng = myRange.Find(What:="", SearchFormat:=True)

If Not FoundRng Is Nothing Then

iRow = FoundRng.Row

iColumn = FoundRng.Column

MsgBox "Ячейка найдена по адресу: " & Chr(13) & "Ряд: " & iRow & Chr(13) & "Столбец: " & iColumn, vbInformation, ""

Else

MsgBox "Ячейка не найдена!", vbExclamation, ""

End If

End Sub

Поиск отрицательного значения в диапазоне и выделения синим цветом

Поиск наличия значения в столбце

Sub Макрос1()

Dim iCell As Range

Set iCell = Columns(1).Find(What:="*", LookIn:=xlFormulas, SearchDirection:=xlPrevious)

If Not iCell Is Nothing Then

MsgBox "Номер последней заполненной строки в столбце A: " & iCell.Row, , ""

Else

MsgBox "Столбец ""A"" не содержит данных", vbExclamation, ""

End If

End Sub