Excel мой финансовый аудитор

Привет всем. Немного предыстории.
Как, наверняка, любая жена, моя очень любит считать деньги. Притом не просто:«сколько заработали и сколько потратили». Нет, она разделяет их на группы и подсчитывает их каждый день. Это дело довольно утомительное и занимает довольно много времени, из-за чего я очень часто вижу свою любимую сидящей за столом спиной ко мне. Что бы облегчить ей труд, и из-за своих корыстных побуждений, я сделал небольшую считалку.

Несколько дней я выпытывал, что бы она хотела от считалки. Ценой немыслимых усилий получился довольно маленький список:

Требования

• Учет Доходов
  
  1. Дата поступления
  2. Сумма поступления
  3. На чью карту или налом
  
  
• Учет Расходов
  
  1. Дата расходов
  2. Сумма расходов
  3. На что потратили
  
  
• Сколько денег у нас осталось
• На что тратим деньги(график)

Выбор

Как у любого программиста, у меня возник вопрос: «На чем писать?». Было много вариантов от Python до Java. Но, так как я человек довольно ленивый, «рисовать» кнопочки мне никак не хотелось. И тут я повнимательнее посмотрел на Excel. «Так вот он интерфейс» — сказал я себе. И правда, что может еще нагляднее объяснить куда делись твои деньги, чем таблица (я не говорю про инфографику), да и работать с ней может каждый.

Процесс

Итак, создаем книгу Excel, там по умолчанию есть три листа, нам вполне этого хватит.

Первый лист(«Лист 1»)

В строке «1» впишем Дата, Сумма, Карта/Наличные, Итого



Итак, колонка «Дата» имеет формат «Дата», «Сумма» — Денежный с округлением до целого. С колонкой «Карта/Наличные» придется немного повозиться. Для начала сделаем список, который будет выпадать в этой колонке.
Нажмем «Ctrl»+«Стрелка вправо», и окажемся в самом правом столбце листа. Вот тут и напишем список:

• Карта моя
• Карта жены
• Наличные

Теперь встанем на ячейку «D2» и нажмем «Ctrl»+«Стрелка вниз». Так мы выделим всю колонку без шапки.
Создадим выпадающий список для этих ячеек. «Данные»->«Проверка...». В открытом окошке выбираем «Тип данных»: «Список», и в «Источник» указываем ту колонку в которой написали список, у меня пример получилось "=$IV:$IV".
Мы выделяем всю колонку для того, что бы, если у нас прибавится пункт, нам не нужно будет переназначать меню.
Теперь у наших ячеек появился выпадающий список.



И наконец, в колонке «Итого» в ячейки «D2»: формула будет такая — "=СУММ(B2:B65536)"
Первый лист готов. Здесь будут наши доходы.

Второй лист(«Лист 3»)

Здесь все тоже самое, только вместо колонки «Карта/Наличные» будет колонка «На что», и еще поменяется выпадающий список, мой, например, пока содержит такие записи.

• Продукты
• Сигареты
• Проезд
• Пиво

Третий лист(«Данные»)

Самое интересное. Выглядит лист примерно так:


В ячейке «А2» формула — "=Лист1!D2-Лист3!D2", и еще добавьте на лист график.



Мне кажется, что круговой нагляднее.

Теперь создадим панель, чтобы удобнее было запускать макросы. Правой кнопкой по ToolBar`у -> «Настройки» кнопка «Создать». Мое меню называется «MyToolBar», это имя будет использоваться в макросе, так что, если меняете, то не забудьте поменять и там.
У нас появился ToolBar, нажимаем «Alt»+«F11».
Макрос для создания кнопок в ToolBar`e:

Public Sub InitToolBar()
Dim cmdBarSm As CommandBar
Dim ctlNewbtn As CommandBarButton
'Application.CommandBars("MyToolBar").Controls("По месяцам").Delete
'Application.CommandBars("MyToolBar").Controls("По Дням").Delete
'Application.CommandBars("MyToolBar").Controls("По Группам").Delete
Set cmdBarSm = Application.CommandBars("MyToolBar")
Set ctlNewbtn = cmdBarSm.Controls.Add(msoControlButton)
ctlNewbtn.Caption = "По месяцам"
ctlNewbtn.FaceId = 26
ctlNewbtn.OnAction = "getMonth"
Set ctlNewbtn = cmdBarSm.Controls.Add(msoControlButton)
ctlNewbtn.Caption = "По Дням"
ctlNewbtn.FaceId = 28
ctlNewbtn.OnAction = "getDay"
Set ctlNewbtn = cmdBarSm.Controls.Add(msoControlButton)
ctlNewbtn.Caption = "По группам"
ctlNewbtn.FaceId = 31
ctlNewbtn.OnAction = "GetGroup"
End Sub

В закоменченном коде команды для удаления этих кнопок. В первый раз макрос придется запускать так, иначе ругается, что не может найти кнопки.
Мы создали три кнопки для расчета затрат: «По дням»,«По месяцам»,«По группам»; иконки задаются в FaceId, вызываемые макросы в OnAction.

Итак макрос getMonth:

Sub getMonth()
Dim ActSheet As Worksheet
Dim BeginCell As Integer
Dim SumCell As Integer
Dim CurSumCell As Integer
Dim NewData As Boolean
Dim CurData As Date
Dim ValueP As Integer
Dim MonthNow As String

'Удалим старые записи
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Range("A5", "D65536").Select
Selection.Clear
'Выбираем страницу Расходов
Set ActSheet = Worksheets.Item("Лист3")
BeginCell = 2
CurSumCell = 5
ActSheet.Activate

While ActSheet.Cells(BeginCell, 1).Value <> Empty
NewData = True
SumCell = 5
CurData = ActSheet.Cells(BeginCell, 1).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
'Сравниваем
While ActSheet.Cells(SumCell, 1).Value <> Empty
If MonthName(Month(CurData)) = ActSheet.Cells(SumCell, 1).Value Then
NewData = False
End If
SumCell = SumCell + 1
Wend
'Если не нашли
If NewData Then
ActSheet.Cells(CurSumCell, 1).Value = MonthName(Month(CurData))
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Cells(CurSumCell, 3).Value = ActSheet.Cells(CurSumCell, 3).Value + ValueP
CurSumCell = CurSumCell + 1
End If
'Суммируем
If Not NewData Then
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Cells(CurSumCell - 1, 3).Value = ActSheet.Cells(CurSumCell - 1, 3).Value + ValueP
End If
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
BeginCell = BeginCell + 1
Wend

'Выбираем страницу Доходов
Set ActSheet = Worksheets.Item("Лист1")
BeginCell = 2
CurSumCell = 5
ActSheet.Activate

'Колонка A есть Дата
While ActSheet.Cells(BeginCell, 1).Value <> Empty
NewData = True
SumCell = 5
CurData = ActSheet.Cells(BeginCell, 1).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
'Сравниваем
MonthNow = ActSheet.Cells(SumCell, 1).Value
While ActSheet.Cells(SumCell, 1).Value <> Empty
If MonthName(Month(CurData)) = ActSheet.Cells(SumCell, 1).Value Then
NewData = False
End If
SumCell = SumCell + 1
Wend
'Если не нашли
If NewData Then
ActSheet.Cells(CurSumCell, 1).Value = MonthName(Month(CurData))
Set ActSheet = Worksheets.Item("Лист1")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Cells(CurSumCell, 2).Value = ActSheet.Cells(CurSumCell, 2).Value + ValueP
CurSumCell = CurSumCell + 1
End If
'Суммируем
If Not NewData Then
Set ActSheet = Worksheets.Item("Лист1")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value

Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
If ActSheet.Cells(CurSumCell - 1, 1).Value <> MonthName(Month(CurData)) Then
ActSheet.Cells(CurSumCell, 4).FormulaR1C1 = "=RC[-2]-RC[-1]"
CurSumCell = CurSumCell + 1
End If
ActSheet.Cells(CurSumCell - 1, 2).Value = ActSheet.Cells(CurSumCell - 1, 2).Value + ValueP
End If
Set ActSheet = Worksheets.Item("Лист1")
ActSheet.Activate
BeginCell = BeginCell + 1
Wend
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
End Sub

Макрос getDay:

Sub getDay()
Dim ActSheet As Worksheet
Dim BeginCell As Integer
Dim SumCell As Integer
Dim CurSumCell As Integer
Dim NewData As Boolean
Dim CurData As Date
Dim ValueP As Integer
Dim MonthNow As String

'Удалим старые записи
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Range("F5", "G65536").Clear
'Выбираем страницу Расходов
Set ActSheet = Worksheets.Item("Лист3")
BeginCell = 2
CurSumCell = 5
ActSheet.Activate

While ActSheet.Cells(BeginCell, 1).Value <> Empty
NewData = True
SumCell = 5
CurData = ActSheet.Cells(BeginCell, 1).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
'Сравниваем
While ActSheet.Cells(SumCell, 6).Value <> Empty
If CurData = ActSheet.Cells(SumCell, 6).Value Then
NewData = False
End If
SumCell = SumCell + 1
Wend
'Если не нашли
If NewData Then
ActSheet.Cells(CurSumCell, 6).Value = CurData
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Cells(CurSumCell, 7).Value = ActSheet.Cells(CurSumCell, 7).Value + ValueP
CurSumCell = CurSumCell + 1
End If
'Суммируем
If Not NewData Then
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Cells(CurSumCell - 1, 7).Value = ActSheet.Cells(CurSumCell - 1, 7).Value + ValueP
End If
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
BeginCell = BeginCell + 1
Wend

Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
End Sub

И наконец последний GetGroup
Sub GetGroup()
Dim ActSheet As Worksheet
Dim BeginCell As Integer
Dim SumCell As Integer
Dim CurSumCell As Integer
Dim NewData As Boolean
Dim CurGroup As String
Dim ValueP As Integer

Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Range("I5", "J65536").Clear
Set ActSheet = Worksheets.Item("Лист3")
BeginCell = 2
CurSumCell = 5
ActSheet.Activate

While ActSheet.Cells(BeginCell, 3).Value <> Empty
NewData = True
SumCell = 5
CurGroup = ActSheet.Cells(BeginCell, 3).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
'Сравниваем
While ActSheet.Cells(SumCell, 9).Value <> Empty
If CurGroup = ActSheet.Cells(SumCell, 9).Value Then
NewData = False
CurSumCell = SumCell + 1
End If
SumCell = SumCell + 1
Wend
'Если не нашли
If NewData Then
If ActSheet.Cells(CurSumCell, 9).Value <> Empty Then
CurSumCell = CurSumCell + 1
End If
ActSheet.Cells(CurSumCell, 9).Value = CurGroup
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Cells(CurSumCell, 10).Value = ActSheet.Cells(CurSumCell, 10).Value + ValueP
CurSumCell = CurSumCell + 1
End If
'Суммируем
If Not NewData Then
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActSheet.Cells(CurSumCell - 1, 10).Value = ActSheet.Cells(CurSumCell - 1, 10).Value + ValueP
End If
Set ActSheet = Worksheets.Item("Лист3")
ActSheet.Activate
BeginCell = BeginCell + 1
Wend
Set ActSheet = Worksheets.Item("Данные")
ActSheet.Activate
ActiveSheet.Shapes("Chart 1").Select
ActiveChart.SetSourceData Source:=Sheets("Данные").Range("I5:J" + CStr(CurSumCell - 1)), PlotBy:= _
xlColumns
End Sub


Вот тут интересный момент
ActiveSheet.Shapes("Chart 1").Select
ActiveChart.SetSourceData Source:=Sheets("Данные").Range("I5:J" + CStr(CurSumCell - 1)), PlotBy:= _
xlColumns

В Range не забудьте указать ваш диапазон, если вы, конечно, меняли форматирование листа «Данные».

Заключение

Теперь все готово. Я, конечно, не претендую на идеальность кода макроса, но со своей задачей он справляется хорошо. Я думаю, что данная считалка пригодится многим и сэкономит немного времени, чтобы провести его со своими любимыми в эти новогодние праздники.