Создание информационной системы средствами МС Excel и VBA

'

 

'

    ActiveWindow.SmallScroll Down:=-33

    Range("F1:G1").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=15

    Range("B38").Select

    ActiveSheet.Paste

    Range("B39").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "1"

    Range("C39").Select

    ActiveCell.FormulaR1C1 = "<30"

    Range("B38:C39").Select

    With Selection

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    Range("D38").Select

End Sub

Так же, при выполнение расширенного фильтра записала макрос, для кнопки «Расширенный фильтр» :

Sub расширфильтр()

'

' расширфильтр Макрос

' Макрос записан 10.05.2009 (Венера)

'

 

'

    ActiveWindow.SmallScroll Down:=-21

    Range("A1:H36").Select

    Range("A1:H36").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _

        Range("B38:C39"), Unique:=False

    ActiveWindow.SmallScroll Down:=-18

End Sub

Макрос для кнопки «Сброс» служащей для сброса всех действий произведенных на данном листе:

Sub сбросрасширфильтр()

'

' сбросрасширфильтр Макрос

' Макрос записан 10.05.2009 (Венера)

'

 

'

    ActiveWindow.SmallScroll Down:=-3

    ActiveSheet.ShowAllData

    ActiveWindow.SmallScroll Down:=12

    Range("B38:C39").Select

    Selection.ClearContents

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    Selection.Interior.ColorIndex = xlNone

    Range("E39").Select

End Sub

 

 

 

Нахождение max и min

Найдём при помощи функции БД максимальный и минимальный вес  багажа, из всех багжей пассажиров 578 рейса. Для этого воспользуемся функциями ДМАКС и ДМИН. ДМАКС – возвращает наибольшее число в столбце списка или БД, которое удовлетворяет заданным условиям. ДМИН- возвращает наименьшее число в столбце списка или БД, которое удовлетворяет заданным условиям.

Для начала я создала диапазон критериев – max, min вес багажа должен находится среди багажа пассажиров 578 рейса(рис.17):

  Рис.17

Вызываем функции БД и выбираем ДМАКС, перед нами выводится окно, куда мы вносим запрашиваемые данные (рис.18):

Рис.18

После, вызываем функцию ДМИН, и  в выведенное окно вновь вносим запрашиваемые данные (рис.19):

  Рис.19

После произведённых действий получаем следующее (рис.20):

Рис.20

Макрос для кнопки «Нахождение max»:

Sub Дмакс()

'

' Дмакс Макрос

' Макрос записан 08.05.2009 (Венера)

'

'

    Range("D39").Select

    ActiveCell.FormulaR1C1 = _

        "=DMAX(R[-38]C[-3]:R[-3]C[4],R[-38]C[3],R[-1]C[-1]:RC[-1])"

End Sub

Макрос для кнопки «Нахождение min»:

Sub Дмин()

'

' Дмин Макрос

' Макрос записан 08.05.2009 (Венера)

'

'

    ActiveWindow.SmallScroll Down:=-6

    Range("E39").Select

    ActiveCell.FormulaR1C1 = _

        "=DMIN(R[-38]C[-4]:R[-3]C[3],R[-38]C[2],R[-1]C[-2]:RC[-2])"

End Sub

Кнопка «Сброс» действий:

Sub сброс()

' сброс Макрос

' Макрос записан 08.05.2009 (Венера)

'

'

    Range("D39:E39").Select

    Selection.ClearContents

    Range("E44").Select

End Sub

Среднее значение

Мне необходимо вычислить средний  вес багажа воспользовавшись данными  о весе багажа всей БД. Для этого  я воспользуюсь функцией БД- ДСРЗНАЧ.  ДСРЗНАЧ – вычисляет среднее значение в столбце списка или БД среди значений, удовлетворяющих заданным условиям. Диапазон критериев в моей задаче будет выглядеть следующим образом(рис.21):

  Рис.21

Вызываем функции БД, затем среди  всех функций выбираем – ДСРЗНАЧ, перед нами выходит окно, которое  запрашивает данные необходимые для вычисления среднего значения (рис.22):

Рис.22

И получаем средний вес багажа (рис.23):

 Рис.23

Так же и при вычислении среднего значения я записала макрос для кнопки «Функция ДСРЗНАЧ» :

Sub средзнач()

'

' средзнач Макрос

' Макрос записан 08.05.2009 (Венера)

'

 

'

    Range("F38").Select

    ActiveCell.FormulaR1C1 = _

        "=DAVERAGE(R[-37]C[-5]:R[-2]C[2],R[-37]C[1],R[-37]C[1]:R[-2]C[1])"

End Sub

А так же создала кнопку «Сброс»  на данном листе, для автоматического  удаления вычисленного среднего веса:

Sub сброссред()

'

' сброссред Макрос

' Макрос записан 08.05.2009 (Венера)

'

 

'

    Range("F38").Select

    Selection.ClearContents

End Sub

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Сумма

Вычислим общий вес багажа для  рейса 387. Для этого, не сомненно, придётся использовать функцию БДСУММ. БДСУММ – суммирует числа в столбце списка или БД, которые удовлетворяют заданным условиям. Самым первым действием создадим диапазон критериев (рис.24)

 Рис.24

После обращаемся к функциям БД  и выбираем функцию – БДСУММ, на рабочий лист выводится окно, куда мы вносим запрашиваемые, для данной функций данные (рис.25):

 Рис.25

При нажатии на кнопку ОК, мы получаем общий вес багажа всех пассажиров рейса 387 (рис.26):

  Рис.26

При использовании данной функции  мною была запущена запись макросов для кнопки «Функция БДСУММ» :

Sub суммавеса()

'

' суммавеса Макрос

' Макрос записан 08.05.2009 (Венера)

'

 

'

    ActiveWindow.SmallScroll Down:=-9

    Range("D39").Select

    ActiveCell.FormulaR1C1 = _

        "=DSUM(R[-38]C[-3]:R[-3]C[4],R[-38]C[3],R[-1]C[-1]:RC[-1])"

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

End Sub

А так же для кнопки «Сброс» действий на этом листе:

Sub сброссумма()

'

' сброссумма Макрос

' Макрос записан 08.05.2009 (Венера)

'

 

'

    Range("D39").Select

    Selection.ClearContents

End Sub

 

 

 

 

 

 

 

Извлечение

Из всей БД мне необходимо найти  пассажира, чей вес багажа равен 23 кг. Для этого я воспользуюсь функцией БИЗВЛЕЧЬ. БИЗВЛЕЧЬ – извлекает отдельное значение из столбца списка или БД, которое удовлетворяет заданным усолвиям. Если такой ячейки не обнаружено, возвращает значение #ЗНАЧ!. Если заданным условиям удовлетворяют несколько ячеек, то возвращается ошибочное значение # ЧИСЛО!

Для начала, необходимо создать диапазон критериев (рис.27):

 Рис.27

После вызываем функции БД и  находим и выбираем среди всех функций- БИЗВЛЕЧЬ. Вносим необходимые данные в появившееся окно (рис.28):

 Рис.28

Нажав на кнопку ОК мы получим следующее (рис.29):

 Рис.29

Макрос для кнопки «Функция БИЗВЛЕЧЬ»:

Sub извлечь()

'

' извлечь Макрос

' Макрос записан 08.05.2009 (Венера)

'

 

'

    Range("E39").Select

    ActiveCell.FormulaR1C1 = _

        "=DGET(R[-38]C[-4]:R[-3]C[3],R[-38]C[-3],R[-1]C[-1]:RC[-1])"

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

End Sub

Макрос для кнопки «Сброс» действий на данном листе:

Sub сбросизвлечь()

'

' сбросизвлечь Макрос

' Макрос записан 08.05.2009 (Венера)

'

 

'

    Range("E39").Select

    Selection.ClearContents

    Range("E44").Select

End Sub

 

 

 

 

 

 

 

Счёт

В задании требуется среди всей БД найти кол-во билетов с № 1. В этом поможет функция БСЧЁТ. БСЧЁТ – подсчитывает кол-во ячеек, содержащих числа, в столбце списка или БД среди всех записей, удовлетворяющих заданным условиям.

Создадим диапазон критериев (рис.30):

 Рис. 30

Вызовем функции БД и выберем -  БСЧЁТ. В появившемся перед нами окне БСЧЁТ, вводим данные (рис.31):

 Рис.31

После на рабочем листе получаем следующее (рис.32):

Рис.32

Была создана кнопка «Функция БСЧЁТ», при нажатии на которую, благодаря  записанным макросам происходит автоматический счёт всех билетов с данным номером:

Sub счёт()

'

' счёт Макрос

' Макрос записан 08.05.2009 (Венера)

'

 

'

    ActiveWindow.SmallScroll Down:=3

    Range("E39").Select

    ActiveCell.FormulaR1C1 = _

        "=DCOUNT(R[-38]C[-4]:R[-3]C[3],R[-38]C[3],R[-1]C[-1]:RC[-1])"

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

End Sub

Сброс всех действий на данном листе  кнопка «Сброс»:

Sub сброссчёт()

'

' сброссчёт Макрос

' Макрос записан 08.05.2009 (Венера)

'

 

'

    Range("E39").Select

    Selection.ClearContents

End Sub

 

 

 

 

 

 

 

 

Промежуточные итоги

Команда Данные/Итоги. . . создаёт промежуточные и общие итоги. Для подведения итогов можно использовать различные функции: Сумма, Кол-во значений, Среднее. Максимум, Минимум, Произведение и др. Мне необходимо вычислить общий вес и общее количество вещей багажа каждого рейса.

Для начала отсортируем исходный список по полю Рейс (рис.33):

Рис.33

Затем воспользуемся командой Данные/Итоги…на экране появится диалоговое окно (рис.34):

 Рис.34

При каждом изменении в столбце  Рейс, будет проводится операция сложения (суммы) кол-ва и веса багажа, по данному рейсу (рис.35):

Рис.35

Макрос для кнопки «Итоги»:

Sub итоги()

'

' итоги Макрос

' Макрос записан 10.05.2009 (Венера)

'

 

'

    ActiveWindow.SmallScroll Down:=-27

    Range("A1:H36").Select

    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(6, 7), _

        Replace:=True, PageBreaks:=False, SummaryBelowData:=True

    ActiveWindow.SmallScroll Down:=15

    Range("I42").Select

    ActiveWindow.SmallScroll Down:=3

    Range("A44:H45").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    Range("J39").Select

End Sub

Макрос для кнопки «Сброс» всех итогов, возврат к БД:

Sub итогисброс()

'

' итогисброс Макрос

' Макрос записан 10.05.2009 (Венера)

'

 

'

    ActiveWindow.SmallScroll Down:=-27

    Range("A1:H45").Select

    ActiveWindow.SmallScroll Down:=0

    Selection.RemoveSubtotal

    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    ActiveWindow.SmallScroll Down:=0

End Sub

 

 

 

 

 

 

 

 

 

 

 

Сводная таблица

Сводные таблицы позволяют объединить данные базы данных и представить в различных вариантах. Например, нам нужно узнать общее кол-во вещей багажа каждого рейса. Для этого выбираем команду Данные / Сводная таблица. Затем с помощью «Мастера сводных таблиц и диаграмм» указываем диапазон содержащий исходные данные и выбираем место расположения сводной таблицы. Из «Списка полей сводной таблицы», выбираем «Багаж (кол-во)», также берем «Рейс», затем поочередно курсором перетаскиваем их в сводную таблицу. В итоге, получаем сводную таблицу (рис.36):

 Рис.36

Сводная диаграмма

На основе сводной таблицы можно  создать и сводную диаграмму. Выделим какую-либо ячейку на сводной  таблице, и кликнем правой кнопкой  мыши, из предложенного списка выберем  «Сводная диаграмма»  и автоматически  на др. листе выведется диаграмма  на основе данных сводной таблицы.(рис.37) :

Рис.37

Макрос для перехода от сводной  диаграммы к сводной таблице:

Sub ксводной()

'

' ксводной Макрос

' Макрос записан 21.05.2009 (Венера)

'

 

'

    ActiveWindow.ScrollWorkbookTabs Position:=xlLast

    Sheets("Сводная таблица").Select

End Sub

И наоборот, макрос для перехода от сводной таблицы к диаграмме:

Sub диаграммсвод()

'

' диаграммсвод Макрос

' Макрос записан 21.05.2009 (Венера)

'

 

'

    Sheets("Сводная диаграмма").Select

End Sub

 

 

 

 

 

 

 

 

 

 

 

 

 

Диаграмма

Программа Microsoft Excel предоставляет пользователю широкие возможности для визуализации числовых данных из таблиц. Двумерное изображение при этом называется диаграммой, объемное – гистограммой. Числовые ряды можно представить в виде графиков. Не важно, какую форму представления данных вы выберите, порядок действий будет один и тот же. При этом будет работать программа, которая называется Мастером диаграмм. Пользователю только необходимо в окне диалога определить параметры изображения.