«Макрос выполнения запроса» VBA Excel
Задание:
Написать VBA макросы для следующих запросов
- Список «клиент-стоимость покупки-дата покупки» для покупок совершенных в январе 2015 года стоимостью более 1500 руб.
- Список «клиент-суммарную стоимость его покупок» за все время ведения БД.
Условие:
Вывод новой таблицы (результатов запроса) должен осуществляться на том же листе, начиная с ячейки «L1».
Существует и ведется БД Excel учета покупок в супермаркете или интернет-магазине.
Данные располагаются по колонкам следующим образом
- А – номер по порядку;
- B – дата покупки;
- С – наименование товара;
- D – стоимость товара (покупки);
- E – фамилия и инициалы клиента;
Решение:
Ответ на вопрос «Как получить новые (нужные) данные на листе Excel из исходных (уже имеющихся) данных – всего ЗА ОДИН КЛИК» - тривиально прост!
Макрос – это программа преобразования «исходных данных» в нужные «результирующие данные».
Фильтрация данных – это как процесс получения полезного продукта из руды…, то есть отсев всего не нужного и повышение, таким образом, полезности информации…
Конечно, можно писать каждый макрос отдельно… и тогда значительная часть кода будет в них дублироваться …, но в нашей задаче сразу говорится о двух макросах и, поэтому, можно (т.е. следует) общие однообразные действия выделить в отдельные функции.
Так, например: очистка области листа Excel под новую таблицу (от старых данных)
Private Sub myClear()
Range(Range("L1"), Range("L1").Offset(1000, 10)).ClearContents
End Sub
Для хранения данных, относящихся к одной операции, удобно сделать «сверхпростой» класс «Операция»… без единого метода… с открытыми полями: идентифицирующий номер, дата, продукт, цена, клиент и одним логическим полем, показывающим, включен ли объект в коллекцию…
И написать функцию, которая, получая единственным параметром (аргументом) 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 руб.
Макрос, обеспечивающий выполнение данного запроса может выглядеть так:
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 'откуда начинать вывод новой таблицы
Список «клиент-суммарную стоимость его покупок» за все время ведения БД.
Макрос может выглядеть так:
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»
Поделиться в соц сетях:
