2курс 2сем / 6

ассистент

М. С. Иванова

должность, уч. степень, звание

подпись, дата

инициалы, фамилия

ОТЧЕТ О ЛАБОРАТОРНОЙ РАБОТЕ №6

ФИЛЬТРАЦИЯ ДАННЫХ СРЕДСТВАМИ VBA

по курсу: ИНФОРМАЦИОННЫЕ СИСТЕМЫ И ТЕХНОЛОГИИ

СТУДЕНТКА ГР.

4716

С.А. Янышева

подпись, дата

инициалы, фамилия

Sub ВыборкаДанныхПоФамилии()

'

' ВыборкаДанныхПоФамилии Макрос

'

'

ActiveSheet.Range("$A$1:$F$9").AutoFilter Field:=1, Criteria1:=Array( _

"Баранов", "Быков", "Рогачев"), Operator:=xlFilterValues

End Sub

Sub Очистка()

'

' Очистка Макрос

'

'

Range("F2:F9").Select

With Selection.Font

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

End With

With Selection.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

End Sub

Private Sub CommandButton1_Click()

Call ЗаданиеФильтра

End Sub

Private Sub CommandButton11_Click()

Call Очистка

End Sub

Private Sub CommandButton12_Click()

Call СнятиеАвтофильтра

End Sub

Private Sub CommandButton2_Click()

Call ФильтрУсловиеАфины

End Sub

Private Sub CommandButton3_Click()

Call Два_Условия

End Sub

Private Sub CommandButton4_Click()

Call ЗаданиеАвтофильраПоДвумСтобцам

End Sub

Private Sub CommandButton5_Click()

Call ЗаданиеФильтраПервые_10

End Sub

Private Sub CommandButton6_Click()

Call ЗаданиеФильтраЦвет_10

End Sub

Private Sub CommandButton7_Click()

Call ФильтрацияПоМесяцуГода

End Sub

Private Sub CommandButton8_Click()

Call ФильтрацияСортировкой

End Sub

Private Sub CommandButton9_Click()

Call массив_критериев_задать

End Sub

Private Sub CommandButton10_Click()

Call ПоискПоУсловию

End Sub

Private Sub ЗаданиеФильтра()

Range("A1:F9").Select

Selection.AutoFilter

End Sub

Sub ФильтрУсловиеАфины()

Range("A1:F1").Select

Selection.AutoFilter

Range("A1:F5").AutoFilter Field:=3, _

Criteria1:="=Афины", _

VisibleDropDown:=False

End Sub

Sub Два_Условия()

'Задание автофильтра

Range("A1:F1").Select

Selection.AutoFilter

'Задание значений параметров автофильтра

Range("A1:F5").AutoFilter Field:=4, _

Criteria1:=">=25000", _

Operator:=xlAnd, _

Criteria2:="<=30000"

'Вывод сообщения

MsgBox "Задали 2 условия на столбец 4"

End Sub

Sub ЗаданиеАвтофильраПоДвумСтобцам()

'Задание параметров двух критериев автофильтра в одном столбце

Range("A1:F9").AutoFilter Field:=4, _

Criteria1:=">=25000", _

Operator:=xlAnd, _

Criteria2:="<=30000"

'Вывод сообщения

MsgBox "Задали 2 условия на столбец 4"

'Задание параметров дополнительного критерия автофильтра

Range("A1:F9").AutoFilter Field:=3, _

Criteria1:="=Афины", _

VisibleDropDown:=False

MsgBox "Задали условие на столбец 3"

'Снятие параметров автофильтра

ActiveSheet.ShowAllData

MsgBox "Снятие условий фильтрации"

End Sub

Sub ЗаданиеФильтраПервые_10()

Range("A1:F9").AutoFilter Field:=4, _

Criteria1:="2", _

Operator:=xlBottom10Items

MsgBox "Отфильтровали две поездки с наименьшей стоимостью"

'*****************************************************

ActiveSheet.ShowAllData

MsgBox "Снятие условий фильтрации"

End Sub

Sub ЗаданиеФильтраЦвет_10()

Range("A1:F9").AutoFilter Field:=6, _

Criteria1:=vbRed, _

Operator:=xlFilterFontColor

MsgBox "Отфильтровали столбец 6 по цвету шрифта (красный)"

End Sub

Sub ФильтрацияПоМесяцуГода()

Range("A1:F9").AutoFilter Field:=5, _

Criteria1:=xlFilterAllDatesInPeriodDecember, _

Operator:=xlFilterDynamic

MsgBox "Отфильтровали декабрьские поездки"

'****************************************************

ActiveSheet.ShowAllData

MsgBox "Сняли условия фильтрации"

End Sub

Sub ФильтрацияСортировкой()

ActiveSheet.Range("$A$1:$F$9").AutoFilter Field:=1, _

Criteria1:=Array("Баранов", "Быков", "Рогачев"), _

Operator:=xlFilterValues

End Sub

Sub массив_критериев_задать()

Dim массив_критериев(1 To 3)

массив_критериев(1) = "Баранов"

массив_критериев(2) = "Быков"

массив_критериев(3) = "Рогачев"

ActiveSheet.Range("A1:F9").AutoFilter Field:=1, _

Criteria1:=массив_критериев(), _

Operator:=xlFilterValues

End Sub

Sub ПоискПоУсловию()

Dim S As Range

Dim SSS As Range

Set SSS = Лист1.Range("F2:F9")

'Задание цикла поиска по условию

For Each S In SSS

If S.Value >= 7 Then

'Установка параметра цвета

S.Interior.ColorIndex = 20

Else

S.Interior.ColorIndex = xlColorIndexNone

End If

Next S

End Sub

Sub автофильтр()

'Использование автофильтра для обычного диапазона

'Активизвция листа с именем «автофильтр»

Worksheets("Лист1").Activate

'Вывод сообщения о том, сколько автофильтров установлено «количество/0»

'и заданных условиях фильтрации «количество/0»

MsgBox "Фильтр на листе установлен: " & ActiveSheet.AutoFilterMode & vbNewLine & _

"Условия фильтации на листе заданы: " & ActiveSheet.FilterMode

'*********************************************

'Установка автофильтра с использованием метода AutoFilter объекта Range

Range("A1:F9").AutoFilter

'Вывод сообщений об установке автофильтров

MsgBox "Установили/сняли фильтр, условия отбора не задавали"

'Вывод сообщения о том, сколько автофильтров установлено «количество/0»

'и заданных условиях фильтрации «количество/0»

MsgBox "Фильтр на листе установлен: " & ActiveSheet.AutoFilterMode & vbNewLine & _

"Условия фильтации на листе заданы: " & ActiveSheet.FilterMode

'*****************************************

Range("A1:F9").AutoFilter Field:=4, _

Criteria1:=">=25000", _

Operator:=xlAnd, _

Criteria2:="<=30000"

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

MsgBox "Задали 2 условия на столбец 4"

'Вывод сообщения о том, сколько автофильтров установлено «количество/0»

'и заданных условиях фильтрации «количество/0»

MsgBox "Фильтр на листе установлен: " & ActiveSheet.AutoFilterMode & vbNewLine & _

"Условия фильтации на листе заданы: " & ActiveSheet.FilterMode

End Sub

Sub СнятиеАвтофильтра()

Range("A1:F9").AutoFilter Field:=4, _

Criteria1:="2", _

Operator:=xlBottom10Items

MsgBox "Отфильтровали 2 поездки с наименьшей стоимостью"

'***********************************************

'Снятие всех фильтров

ActiveSheet.ShowAllData

'Вывод сообщения о снятии условий фильтрации

MsgBox "Сняли условия фильтрации"

End Sub