«Макрос выполнения запроса»
– т.е. формирование новой таблицы из базы данных (БД Excel).



Задание:

Написать VBA макросы для следующих запросов

  1. Список «клиент-стоимость покупки-дата покупки» для покупок совершенных в январе 2015 года стоимостью более 1500 руб.
  2. Список «клиент-суммарную стоимость его покупок» за все время ведения БД.

Условие:

Вывод новой таблицы (результатов запроса) должен осуществляться на том же листе, начиная с ячейки «L1».
Существует и ведется БД Excel учета покупок в супермаркете или интернет-магазине.
Данные располагаются по колонкам следующим образом

  • А – номер по порядку;
  • B – дата покупки;
  • С – наименование товара;
  • D – стоимость товара (покупки);
  • E – фамилия и инициалы клиента;

Решение:

Ответ на вопрос «Как получить новые (нужные) данные на листе Excel из исходных (уже имеющихся) данных – всего ЗА ОДИН КЛИК» - тривиально прост!
Макрос – это программа преобразования «исходных данных» в нужные «результирующие данные».
Фильтрация данных – это как процесс получения полезного продукта из руды…, то есть отсев всего не нужного и повышение, таким образом, полезности информации…

Конечно, можно писать каждый макрос отдельно… и тогда значительная часть кода будет в них дублироваться …, но в нашей задаче сразу говорится о двух макросах и, поэтому, можно (т.е. следует) общие однообразные действия выделить в отдельные функции.

Так, например: очистка области листа Excel под новую таблицу (от старых данных)

Private Sub myClear()
    Range(Range("L1"), Range("L1").Offset(1000, 10)).ClearContents
End Sub

Для хранения данных, относящихся к одной операции, удобно сделать «сверхпростой» класс «Операция»… без единого метода… с открытыми полями: идентифицирующий номер, дата, продукт, цена, клиент и одним логическим полем, показывающим, включен ли объект в коллекцию…

VBA Excel вспомогательный класс

Рис.1 - Пример класса "Operac" для ввода и хранения данных (без методов)

И написать функцию, которая, получая единственным параметром (аргументом) i-номер строки листа Excel, возвращает объект данного класса с инициализированными данными

Private Function NewOperac(i As Integer) As Operac
Dim A As New Operac
    A.ID = Cells(i, 1)
    A.Dat = Cells(i, 2)
    A.Product = Cells(i, 3)
    A.Price = Cells(i, 4)
    A.Client = Cells(i, 5)
    A.InCollection = False
    Set NewOperac = A
End Function


Список «клиент-стоимость покупки-дата покупки» для покупок совершенных в январе 2015 года стоимостью более 1500 руб.

VBA Excel результат запроса

Рис.2 - Пример выполнения первого запроса

Макрос, обеспечивающий выполнение данного запроса может выглядеть так:

Private Sub query10()
Dim A As Operac
Dim i As Integer
Dim j As Integer

myScan 'сканирование БД для определения последней строки

j = nRow
'вывод заголовков полей для данного запроса
Cells(j, nCol) = "Клиент"
Cells(j, nCol + 1) = "Стоимость покупки"
Cells(j, nCol + 2) = "Дата покупки"

For i = 2 To n + 1
    Set A = NewOperac(i)
    If Mid(A.Dat, 4, 7) = "01.2015" Then
        If A.Price >= 1500 Then
            j = j + 1
            Cells(j, nCol) = A.Client
            Cells(j, nCol + 1) = A.Price
            Cells(j, nCol + 2) = A.Dat
        End If
    End If
Next i
End Sub

Где nRow = 1, nCol = 12 - это константы, описанные в начале модуля…

Const nRow As Integer = 1, nCol As Integer = 12 'откуда начинать вывод новой таблицы

Список «клиент-суммарную стоимость его покупок» за все время ведения БД.

VBA Excel результат запроса

Рис.3 - Пример выполнения второго запроса

Макрос может выглядеть так:

Private Sub query20()
Dim elem As Operac, A As Operac
Dim C As New Collection
Dim i As Integer
Dim j As Integer

myScan 'сканирование БД для определения последней строки

j = nRow
'вывод заголовков полей для данного запроса
Cells(j, nCol) = "Клиент"
Cells(j, nCol + 1) = "Сумма всех покупок"

For i = 2 To n + 1
    Set A = NewOperac(i)
    For Each elem In C
       If elem.Client = A.Client Then 'покупатель не уникальный, он уже есть в коллекции
            elem.Price = elem.Price + A.Price
            A.InCollection = True
            Exit For
        End If
    Next
    If Not A.InCollection Then C.Add A 'добавляю в коллекцию уникального покупателя
Next i
'вывод результата
For Each elem In C
    j = j + 1
    Cells(j, nCol) = elem.Client
    Cells(j, nCol + 1) = elem.Price
Next
End Sub

Скачать файл для тестирования

Другие примеры на тему «Автоматизация документов Microsoft Office Excel, Word, Access»

Другие примеры на языке «Visual Basic for application - VBA»





Если на этой странице не нашлось того, что Вы так искали...

         Не расстраивайтесь, не все потеряно... Смело щелкайте...

исходный код на заказ. orenstudent.ru Автоматизация документов MS Office. orenstudent.ru исходный код на заказ. orenstudent.ru Помогите найти и устранить ошибку в исходном коде программы. orenstudent.ru Skype-консультирование по программированию
Скайп-консультации

Акция !!!
Весь код по 49 руб


требуются
школьники!


и СТУДЕНТЫ!
Кому не плевать
на деньги!
Сайт помощи студентам по программированию и информатике

Program code