Главная | Обратная связь | Поможем написать вашу работу!
МегаЛекции

Симулирование ячеек рабочего листа

Метод Evaluate позволяет симулировать работу с ячейками или диапазонами рабочего листа без реального воплощения этих действий на рабочем листе.

 

Листинг 7. Симулирование ввода данных в ячейки и считывание из них значений

Public Sub Simur()

Evaluate("A1").Value = 25

Evaluate("A2").Formula = "A1^2"

MsgBox Evaluate("A2").Value

End Sub

 

Листинг 8 Симулирование ячеек

Public Sub stimulirovanie()

Dim firstCell As Range

Dim secondCell As Range

Set firstCell = Evaluate("A1")

Set secondCell = Evaluate("A2")

firstCell.Value = 25

secondCell.Formula = "A1^2"

MsgBox secondCell.Value

End Sub

 

Электронные часы в ячейке рабочего листа

Метод позволяет создать электронные часы. Для этого достаточно рекурсивно вызывать процедуру, в которой считывается текущее время. Затем оно выводится в ячейку рабочего листа, найденное время увеличивается на секунду, и уже для вычисленного нового времени устанавливается рекурсивный вызов процедуры.

 

Листинг 9. Электронные часы в ячейке рабочего листа. Стандартный модуль

Sub DemoClock()

DemoOnTime

End Sub

 

Sub DemoOnTime()

 Dim newHour, newMinute, newSecond, newTime

 Cells(1, 1).Value = Now

 newHour = Hour(Now)

 newMinute = Minute(Now)

 newSecond = Second(Now)

 newTime = TimeSerial(newHour, newMinute, newSecond)

 Application.OnTime EarliesTime:=newTime, Procedure:="DemoOnTime"

End Sub

 

Доступ к отдельным ячейкам диапазона

Свойство Cells объекта Range, использованное без индексов, возвращает все ячейки диапазона, а с индексов- конкретную ячейку, специфицированную либо ее номером(один параметр), либо местоположением (два параметра).

Например, в следующем коде в диапазоне В1:С3 все положительные значения заменяются на 1, а отрицательные на -1.

 

Листинг 10. Все ячейки диапазона

Dim a as Range

For Each a in Range (В1:С3).Cells

If a.Value >0 Then

a.Value =1

Else if a.Value < 0 then

a.Value =-1

End if

Next

 

Листинг  11

Dim i As Integer Dim j As Integer

For i = 1 To Range("B1:C3").Columns.Count For j = 1 To Range("Bl:C3").Columns.Count

If Range("B1:C3")-Cells(i, j).Value > 0 Then

Range("Bl:C3").Cells(i, j).Value = 1 Elself Range("B1:C3")-Cells(i, j).Value < 0 Then

Range("B1:C3").Cells(i, j).Value = -1

End If

Next

Next 

Если требуется задать абсолютное местоположение ячеек, то надо воспользоваться свойством Cells рабочего листа, например как в листинге 12.

Листинг 12. Абсолютное местоположение ячеек

Dim i As Integer Dim j As Integer For i = 2 To 3 For j = 1 To 3

If Cells(i, j).Value > 0 Then

Cells(i, j).Value = 1 Elself Cells(i, j).Value < 0 Then

Cells(i, j).Value = -1

End If

 Next

 Nex

 

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

Метод Find объекта Range производит поиск специфицированной информации в указанном диапазоне и возвращает ссылку на первую ячейку, в которой требуемая информация найдена. В случае не обнаружения искомых данных, метод возвращает значение Nothing

 

Листинг 13. Поиск значения

Public Sub Poiskznacheni()

Dim rng As Range

Set rng = Range("A1:A10").Find(What:=17, LookIn:=xlValues)

If Not (rng Is Nothing) Then

MsgBox rng.Address

Else

MsgBox "не найдено значение"

End If

End Sub

 

Листинг 14 Поиск подстроки без учета регистра

Sub DemoFindNoMatchCase()

Dim rng As Range

Set rng = Range("A1:A10").Find(What:="BHV", LookIn:=xlValues, _

LookAt:=xlPart, MatchCase:=False)

If Not (rng Is Nothing) Then

MsgBox rng.Value

Else

MsgBox "не найдено подходяшие значение"

End If

End Sub

 

Повторный поиск и поиск всех значений

Метод FindNext и FindPrevious объекта Range реализует повторный вызов метода Find для продолжения специфицированного поиска. Первый из методов производит поиск следующей ячейки, а второй – поиск предыдущей, удовлетворяющей объявленным критериям поиска.

FindNext (after)

FindPrevious(after)

Здесь after- необязательный параметр, указывающий на ячейку после которой надо производить поиск.

 

Листинг 15. Нахождение всех вхождений подстроки в данный диапазон

Sub DemoFind()

Dim firstAddress As String

Dim rng As Range

Set rng = Range("A1:A10").Find(What:="MS", LookIn:=xlValues, _

LookAt:=xlPart, MatchCase:=False)

If Not (rng Is Nothing) Then

firstAddress = rng.Address

Do

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

Set rng = Range("a1:a10").FindNext(rng)

Loop While Not (rng Is Nothing) And rng.Address <> firstAddress

End If

End Sub

 

Отсылка электронной почты

Отсылка электронной почты с данными рабочего листа может производится при помощи средств Microsoft Outlook.

 

Листинг 16. Отсылка электронной почты

Private Sub cmdEMail_Click()

Dim objOL As New Outlook.Application

Dim objMail As MailItem

Set objOL = New Outlook.Application

Set objMail = objOL.CreateItem(olMailItem)

With objMail

.To = Range("B1").Value

.Body = Range("B2").Value

.Subject = Range("B3").Value

.CC = Range("B4").Value

.Display

End With

Set objMail = Nothing

Set objOL = Nothing

End Sub

 

Условное форматирование

Условное форматирование позволяет эффективно отображать, форматируя ячейки выборочно, основываясь на их содержании.

 

Листинг 17. Условное форматирование

Private Sub optAverage_Click()

Dim r As Range

Set r = Range("B1:B6")

r.FormatConditions.Delete

r.FormatConditions.Add Type:=xlExpression, _

                    Formula1:="=B1>=СРЗНАЧ($B$1:$B$6)"

r.FormatConditions(1).Interior.Color = RGB(255, 255, 0)

End Sub

 

Private Sub optMax_Click()

Dim r As Range

Set r = Range("B1:B6")

r.FormatConditions.Delete

r.FormatConditions.Add Type:=xlCellValue, _

                    Operator:=xlEqual, _

                    Formula1:="$B$9"

With r.FormatConditions(1).Font

.Bold = True

.Italic = False

.Color = RGB(255, 0, 0)

End With

End Sub

Private Sub optValue_Click()

Dim r As Range

Set r = Range("B1:B6")

r.FormatConditions.Delete

r.FormatConditions.Add Type:=xlCellValue, _

                    Operator:=xlGreaterEqual, _

                    Formula1:="$G$8"

r.FormatConditions(1).Interior.Color = RGB(0, 0, 255)

End Sub

 

Поделиться:





Воспользуйтесь поиском по сайту:



©2015 - 2024 megalektsii.ru Все авторские права принадлежат авторам лекционных материалов. Обратная связь с нами...