Демонстрационное приложение «супермаркет»Постановка задачи (по материалам конкурсных экзаменов в ННГУ). При обслуживании покупателей супермаркета используются различные виды скидок: при общей стоимости покупок от 100 до 500 рублей скидка 1\%, до 1000 – 2\%, до 1500 – 3\% и т.д. , но не более 10\%. Кроме того, для покупателей, имеющих клубную карту, размер скидок увеличивается в полтора раза и для некоторых товаров из заданного списка для членов клуба устанавливается специальная цена. Найти суммарные расходы супермаркета на поддержку системы скидок за рассматриваемый период. Определить, какой продукт приносит наибольший доход. Исходными данными считать: список цен на продукты супермаркета, список специальных цен для членов клуба, данные о покупках – наличие клубной карты, название продуктов, для каждого продукта - количество. Разработать алгоритм, дать его описание (общую схему и назначение используемых переменных), привести программу. Контрольный пример Исходные данные:
Решение: Суммарные расходы супермаркета на поддержку системы скидок: 35.12. Наибольший доход приносит говядина.
Руководство пользователя. После того, как пользователь запустил файл «Супермаркет.xls», перед ним открывается рабочая форма программы (смотри рис. 5.). На ней расположены три кнопки: «Старт», «Настройка» и «Выход». Кнопка «Выход» приводит к закрытию программы, если пользователь отвечает на вопрос подтверждения выхода из программы («Вы уверены, что хотите выйти?») положительно («Да»).
рис. 5 Основная форма «Заставка» После нажатия кнопки «Старт», пользователь переходит в форму «Отчет». На этой форме в ячейке рабочего листа «Отчет» получаем ответ «Суммарный размер скидок». Данная форма содержит кнопку «Главное меню», которая позволяет вернуться к форме «Заставка». После нажатия кнопки «Настройка» вызывается рабочий лист «Тест». Можно редактировать информацию, находящуюся на данном рабочем листе. Руководство разработчика. Составные части приложения «Супермаркет(Таблица 7).
Исходный текст приложения. Модуль wsMain
Private Sub cmdStart_Click() VvodTest Raschet End Sub Private Sub cmdSetup_Click() Rem MsgBox "Будет реализована в Версии 1.2!! Выход версии Декабрь 2003" wsTest.Select End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
End Sub Private Sub cmdQuit_Click() Application.Quit End Sub
Подпрограммы VvodTest и Raschet находятся в модуле mMain.
Модуль mMain '---------------------------------------- ' определение экземпляра объекта, в котором ' сохраняется первоначальное состояние Excel '---------------------------------------- Dim mobjAppState As New cApplicationState
'---------------------------------------- ' определение констант '---------------------------------------- Public Const COMMANDBAR_NAME = "Иерархии" Public nPL As Integer ' Количество строк в прайс -листе' Public nSP As Integer ' Количество строк в спец ценах' Public nTC As Integer ' Количество строк в таблице покупок' Public iPL As Integer ' Индекс строк в прайс -листе' Public iSP As Integer ' Индекс строк в спец ценах' Public iTC As Integer ' Индекс строк в таблице покупок' Public ProdTC() As String ' Массив продуктов в таблице покупок' Public ProdPL() As String ' Массив продуктов в прайс -листе' Public PricePL() As Double ' Массив цен в прайс -листе' Public ProdSP() As String ' Массив продуктов в спец ценах' Public PriceSP () As Double ' Массив цен в спец ценах' Public NumTC () As Integer ' Массив № покупок в таблице покупок' Public kTC() As Integer ' Массив наличия клубной карты в таблице покупок' Public qTC() As Double ' Массив количеств в таблице покупок'
Sub RestoreEnvironment() '---------------------------------------- ' Восстановление Excel в первоначальное состояние '---------------------------------------- Application.ScreenUpdating = False With mobjAppState .RestoreState End With With Application.CommandBars("Worksheet Menu Bar") .Reset With .Controls With .Add(msoControlButton) . Caption = "Восстановить" .Style = msoButtonIconAndCaption .OnAction = "SetEnvironment" End With End With End With With ThisWorkbook.Windows(1) .DisplayWorkbookTabs = True End With DeleteCommandBar With ActiveWindow .DisplayHorizontalScrollBar = True .DisplayVerticalScrollBar = True .Caption = Empty End With End Sub
Sub SetEnvironment() '---------------------------------------- ' Сохранение текущего состояния Excel и подготовка ' среды для этого приложения '---------------------------------------- wsMain.Select With Application . Caption = "Супермаркет" . ScreenUPdating = False End With With mobjAppState . Gestate .HideAllCommandBars End With With Application . DisplayFormulBar = False .DisplayStatusBar = False End With ActiveWindow.Caption = "" With ThisWorkbook.Windows(1) .DisplayWorkbookTabs = False End With CreateCommandBar ShowHome
End Sub
Sub CreateCommandBar() '---------------------------------------- ' создание пользовательской панели команд этого приложения '---------------------------------------- Dim MenuBarBool As Boolean MenuBarBool = True DeleteCommandBar With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True) .Visible = True .Position = msoBarTop .Protection = msoBarNoChangeVisible + msoBarNoCustomize With .Controls With .Add(msoControlButton) .Caption = "Редактор кода" .Style = msoButtonCaption .OnAction = "RestoreEnvironment" End With End With End With End Sub
Sub DeleteCommandBar() '---------------------------------------- ' удаление пользовательской панели команд этого приложения '---------------------------------------- On Error Resume Next Application.CommandBars(COMMANDBAR_NAME).Delete End Sub
Sub ShowHome() '---------------------------------------- ' отображение главного листа '---------------------------------------- Application.ScreenUpdating = False wsMain.Select With ActiveWindow Rem .DisplayHorizontalScrollBar = False Rem .DisplayVerticalScrollBar = False End With End Sub Sub VvodTest() 'Подпрограмма ввода контрольного примера' nPL = 1 While (wsTest.Cells(nPL + 3, 2).Value <> 0) nPL = nPL + 1 Wend
ReDim ProdPL(nPL) As String ReDim PricePL(nPL) As Double For iPL = 1 To nPL ProdPL(iPL) = wsTest.Cells(iPL + 3, 1).Value PricePL(iPL) = wsTest.Cells(iPL + 3, 2).Value Next iPL nSP = 1 While (wsTest.Cells(nSP + 3, 7).Value <> 0) nSP = nSP + 1 Wend
ReDim ProdSP(nSP) As String ReDim PriceSP(nSP) As Double For iSP = 1 To nSP ProdSP(iSP) = wsTest.Cells(iSP + 3, 6).Value PriceSP(iSP) = wsTest.Cells(iSP + 3, 7).Value Next iSP
nTC = 1 While (wsTest.Cells(nTC + 3, 14).Value <> 0) nTC = nTC + 1 Wend
ReDim NumTC(nTC) As Integer ReDim kTC(nTC) As Integer ReDim ProdTC(nTC) As String ReDim qTC(nTC) As Double For iTC = 1 To nTC NumTC(iTC) = wsTest.Cells(iTC + 3, 11).Value kTC(iTC) = wsTest.Cells(iTC + 3, 12).Value ProdTC(iTC) = wsTest.Cells(iTC + 3, 13).Value qTC(iTC) = wsTest.Cells(iTC + 3, 14).Value
Next iTC
End Sub Sub Raschet() ' подпрограмма расчета скидок ' Промежуточные массивы Dim nTC_N As Integer ' Количество строк в таблице покупок без повторений' Dim iTC_N As Integer ' Индекс строк в таблице покупок без повторений' Dim nomTC_N As Integer '№ позиции № покупки в таблице покупок без повторений' Dim nomSP As Integer '№ позиции продукта в спец - ценах' Dim nomPL As Integer '№ позиции продукта в прайс - листах' Dim iPL As Integer ' Индекс строк в прайс -листе' Dim iSP As Integer ' Индекс строк в спец ценах' Dim iTC As Integer ' Индекс строк в таблице покупок' ReDim NumTC_N(nTC) As Integer 'Массив номеров в таблице покупок без повторений' ReDim SumTC_N(nTC) As Double 'Массив сумм без скидок в таблице покупок без повторений' ReDim Disc_TC(nTC) As Double 'Массив скидок в таблице покупок без повторений' ReDim kTC_N(nTC) As Integer 'Массив наличия клубной карты в таблице покупок без повторений' Dim Perc As Integer 'Процент скидок на покупку' Rem Dim Perc As Double nTC_N = 0
For iTC = 1 To nTC Rem Поиск элемента NumTC (iTC) в массиве NumTC_N (nTC_N) nomTC_N = 0 iTC_N = 1 While (iTC_N <= nTC_N) And (nomTC_N = 0) If NumTC(iTC) = NumTC_N(iTC_N) Then nomTC_N = iTC_N Else iTC_N = iTC_N + 1 Wend
If nomTC_N = 0 Then nTC_N = nTC_N + 1 NumTC_N(nTC_N) = NumTC(iTC) kTC_N(nTC_N) = kTC(iTC) If kTC(iTC) = 1 Then Rem поиск элемента ProdTC (iTC) в спец ценах ProdSP (nSP) nomSP = 0 iSP = 1 While (iSP <= nSP) And (nomSP = 0) If ProdTC(iTC) = ProdSP(iSP) Then nomSP = iSP Else iSP = iSP + 1 Wend
If nomSP = 0 Then Rem поиск элемента ProdTC (iTC) в прайс листе ProdPL (nPL) nomPL = 0 iPL = 1 While (iPL <= nPL) And (nomPL = 0) If ProdTC(iTC) = ProdPL(iPL) Then nomPL = iPL Else iPL = iPL + 1 Wend
If nomPL = 0 Then Else SumTC_N(nTC_N) = PricePL(nomPL) * qTC(iTC)
End If Else SumTC_N(nTC_N) = PriceSP(nomSP) * qTC(iTC)
End If
Else Rem поиск элемента ProdTC (iTC) в прайс листе ProdPL (nPL) nomPL = 0 iPL = 1 While (iPL <= nPL) And (nomPL = 0) If ProdTC(iTC) = ProdPL(iPL) Then nomPL = iPL Else iPL = iPL + 1 Wend If nomPL = 0 Then Else SumTC_N(nTC_N) = PricePL(nomPL) * qTC(iTC) End If End If Else If kTC(iTC) = 1 Then
Rem поиск элемента ProdTC (iTC) в спец ценах ProdSP (nSP) nomSP = 0 iSP = 1 While (iSP <= nSP) And (nomSP = 0) If ProdTC(iTC) = ProdSP(iSP) Then nomSP = iSP Else iSP = iSP + 1 Wend
If nomSP = 0 Then Rem поиск элемента ProdTC (iTC) в прайс листе ProdPL (nPL) nomPL = 0 iPL = 1 While (iPL <= nPL) And (nomPL = 0) If ProdTC(iTC) = ProdPL(iPL) Then nomPL = iPL Else iPL = iPL + 1 Wend If nomPL = 0 Then Else SumTC_N(nomTC_N) = SumTC_N(nomTC_N) + PricePL(nomPL) * qTC(iTC) End If Else SumTC_N(nomTC_N) = SumTC_N(nomTC_N) + PriceSP(nomSP) * qTC(iTC) End If Else Rem поиск элемента ProdTC (iTC) в прайс листе ProdPL (nPL) nomPL = 0 iPL = 1 While (iPL <= nPL) And (nomPL = 0) If ProdTC(iTC) = ProdPL(iPL) Then nomPL = iPL Else iPL = iPL + 1 Wend If nomPL = 0 Then Else SumTC_N(nomTC_N) = SumTC_N(nomTC_N) + PricePL(nomPL) * qTC(iTC) End If End If End If Next iTC
Rem For iTC_N = 1 To nTC_N Rem MsgBox SumTC_N(iTC_N) Rem Next iTC_N Rem Подсчет скидок Disc_Sum = 0 For iTC_N = 1 To nTC_N If SumTC_N(iTC_N) > 100 Then Perc = Int(SumTC_N(iTC_N) / 500) + 1 Else Perc = 0 If Perc > 10 Then Perc = 10 If kTC_N(iTC_N) = 1 Then Disc_TC(iTC_N) = 1.5 * Perc * SumTC_N(iTC_N) / 100 Else Disc_TC(iTC_N) = Perc * SumTC_N(iTC_N) / 100 Disc_Sum = Disc_Sum + Disc_TC(iTC_N)
Next iTC_N wsReport.Select Range("D15").Value = Disc_Sum Rem MsgBox Disc_Sum End Sub | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
