Заливка диапазона

Автоматизация добавления примечаний в указанном диапазоне

Автоматическое определение адреса ячейки

Создание цветной границы диапазона

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

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

Листинг 2.31. Поиск значения с отображением результата в отдельном окне

Sub Search()

Dim rgResult As Range

' Поиск заданного значения в диапазоне B1:B20 и вывод результата

Set rgResult = Range("B1:B20").Find(9999,, xlValues)

If rgResult Is Nothing Then

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

Else

MsgBox rgResult.Address

End If

End Sub

Листинг 2.32. Выделение найденных данных

Sub FindAndSelect()

Dim strStartAddr As String ' Хранит координаты первого найденного _

значения

Dim rgResult As Range

' Поиск первого входжения искомого слова

Set rgResult = Range("B1:B10").Find("Прибыль",, xlValues)

If Not rgResult Is Nothing Then

' Сохраним адрес найденной ячейки (чтобы контролировать _

зацикливание поиска)

strStartAddr = rgResult.Address

End If

Do While Not rgResult Is Nothing

' Обработка результата поиска

rgResult.Interior.Color = RGB(255, 255, 0)

' Новый поиск

Set rgResult = Range("B1:B10").FindNext(rgResult)

If rgResult.Address = strStartAddr Then

' Поиск завершен

Exit Do

End If

Loop

End Sub

Листинг 2.33. Оформление верхней и нижней границ диапазона

Sub RangeBorder()

Dim rgRange As Range

Set rgRange = Range("B2:D5")

' Оформление верхней границы диапазона

With rgRange.Borders(xlEdgeTop)

.Weight = xlThick

.LineStyle = xlContinuous

.Color = RGB(0, 0, 255)

End With

' Оформление нижней границы диапазона

With rgRange.Borders(xlEdgeBottom)

.Weight = xlMedium

.LineStyle = xlDash

.Color = RGB(255, 0, 255)

End With

End Sub

Листинг 2.34. Информация об адресе активной ячейки

Sub Worksheet_SelectionChange(ByVal Target As Range)

' Вывод адреса ячейки в различных форматах

MsgBox Target.Address() & vbCr & _

Target.Address(RowAbsolute:=False) & vbCr & _

Target.Address(ReferenceStyle:=xlR1C1) & vbCr & _

Target.Address(ReferenceStyle:=xlR1C1, _

RowAbsolute:=False, ColumnAbsolute:=False, _

RelativeTo:=Worksheets(1).Cells(2, 2))

End Sub

Листинг 2.35. Добавление примечаний в диапазон

Sub CreateComments()

Dim cell As Range

' Производим поиск по всем ячейкам диапазона и добавляем примечания _

ко всем ячейкам, содержащим слово "Выручка"

For Each cell In Range("B1:B100")

If cell.Value Like "*Выручка*" Then

cell.ClearComments

cell.AddComment "Неучтенная наличка"

End If

Next

End Sub

Листинг 2.36. Создание заливки диапазона

Sub FillRange()

' Заливка диапазона

With Range("B1:E10")

' Задаем узор - сетчатый

.Interior.Pattern = xlPatternChecker

' Цвет узора - синий

.Interior.PatternColor = RGB(0, 0, 255)

' Цвет ячейки - красный

.Interior.Color = RGB(255, 0, 0)

End With

End Sub

Дата добавления: 2015-06-25