Иногда наступает момент, когда хочется понять куда пропадают деньги? ))) Некоторые начинают вести учет своих доходов и расходов (тут главное понять, что простой их учет, ничего не дает. Учет заводится для того, чтобы анализируя свои доходы и расходы начать планировать свою финансовую деятельность).
Если хорошенько "прошерстить" просторы интернета, то можно найти огромное количество способов и методов учета финансов, начиная от записей карандашом до использования специализированных приложений на компьютере, планшете или телефоне.
Случается так, что иногда предлагаемые способы не всегда удовлетворяют потребности вашего учета, и хочется иметь более гибкий инструмент. В этой статье я предлагаю самостоятельно создать этот инструмент в файле Excel. Правда создание потребует некоторых усилий, так как в этом файле будет одновременно использоваться: программирование на VBA, SQL-запросы и собственные инструменты форматирования Excel, так что в ходе создания своего учета у вас есть возможность научиться или повысить уровень работы с программой Excel (перейдя по этой ссылке, можно посмотреть видео, где показано как это будет работать).
Кроме того, вручную придется заводить только категории расходов и доходов и сами доходы с расходами, т.е. НИКАКИХ ФОРМУЛ. В принципе даже файл можно скачать на телефон и делать записи в нем по мере необходимости, а вечером в спокойной обстановке, используя компьютер заниматься анализом и планированием.
Итак приступаем к созданию нашего "Кошелька"!!!
1. Предварительная подготовка (никакого программирования, только работа с листами Excel)
Для начала создаем новый файл, сохраняем его с именем, какое вам нравится, но сохраняем его в формате: Книга Excel с поддержкой макросов (*.xlsm)
Переименовываем те листы которые есть, или добавляем новые листы и присваиваем следующие имена:
- категории;
- доходы;
- расходы;
- АнализПоМесяцам.
Эти листы будут отображаться в рабочей книге и в них будут производиться основные ваши действия, кроме них нам понадобятся вспомогательные листы, которые будут выполнять роль промежуточных таблиц:
- Даты;
- ОтчетДоходы;
- ОтчетРасходы;
- ДоходыРасходыМесяц;
- ОстаткиМесяц.
1. Теперь заполним лист категории:
2. Заполним листы "Доходы" и "Расходы".
Затем преобразуем второй столбец в выпадающий список, значения которого будут браться из листа "Категории".
Выделить на листе некоторое количество ячеек и на вкладке "Данные"выбрать " команду "Проверка данных"
В появившемся окне в выпадающем списке "Тип данных" выбираем значение "Список". Окно параметров изменится и в новом поле "Источник" вписываем адрес диапазона на листе "Категории", откуда будут браться значения категорий доходов и расходов
После этих операций в строках таблицы "Доходы" в столбце "Категория" для выбора будут предлагаться значения категорий с листа "Категории".
Теперь выделите диапазон с шапкой и несколькими строками и скопируйте их на лист "Расходы"
Ну и для простоты оформления и удобства работы с таблицей отформатируйте как таблицу (выделите таблицу и с помощью команды "Форматировать как таблицу" на главной вкладке выберите понравившийся вам дизайн".
Теперь перейдем на лист "Даты" и заполним его датами
На этом, часть, в которой не нужно никакого программирования на языке VBA, закончилась и переходим к самой главной части нашего документа.
2. Используя программирование на VBA и язык запросов SQL создадим инструмент сбора и анализа наших доходов и расходов
Вообще то, с помощью языка запросов SQL работать удобнее в приложении Microsoft Access, а не в Excel, но и эта программа с помощью VBA позволяет использовать листы Excel аналогично таблицам в Access и получать из них данные с помощью языка запросов SQL. Детально описывать, что я делаю с помощью запросов SQL я не буду, опишу их только в общих чертах.
Итак, переходим в редактор VBA с помощью команды Alt+F11
Затем нам необходимо добавить несколько библиотек, для этого выберите на ленте команды Tools -> References
С помощью этих библиотек программа Excel сможет работать с объектами баз данных, создавать SQL запросы и выводить их результаты на свои рабочие листы.
Добавим в наш модуль следующий код - функцию, которая создаст объекты баз данных, с помощью которых мы будем создавать SQL запросы
Sub connectM(cn As ADODB.Connection, rs As ADODB.Recordset, strFile As String, strCon As String, wb As Workbook)
Set wb = ThisWorkbook
strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
End Sub
Теперь давайте добавим еще один модуль, в котором будем хранить процедуры, с помощью которых будем создавать SQL запросы и выводить их результаты на рабочие листы файла Excel
В модуль 2 добавим следующий код:
Sub ДоходыПомесячно()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strFile As String, strCon As String, strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Integer
Set wb = ThisWorkbook
Call connectM(cn, rs, strFile, strCon, wb)
Set ws = wb.Worksheets("ОтчетДоходы")
ws.UsedRange.Clear
strSQL = "SELECT dateserial(year(Дата), month(Дата),1), SUM(сумма) " & _
"FROM [Доходы$] " & _
"GROUP BY dateserial(year(Дата), month(Дата),1)"
rs.Open strSQL, cn
i = 2
With ws
.Cells(1, 1) = "Месяц"
.Cells(1, 2) = "Доходы"
End With
While Not rs.EOF
If Not IsNull(rs.Fields(0)) = True Then
ws.Cells(i, 1) = CDate(rs.Fields(0))
ws.Cells(i, 2) = (rs.Fields(1))
i = i + 1
End If
rs.MoveNext
Wend
Set rs = Nothing
Set cn = Nothing
End Sub
Результат кода будет выводит на наш вспомогательный лист "ОтчетДоходы" таблицу с суммой доходов за каждый месяц.
Чтобы проверить как он работает, необходимо заполнить наш лист "Доходы".
После того, как вы заполните лист "Доходы" и запустите процедуру "ДоходыПомесячно" в редакторе VBA, на лист "ОтчетДоходы" будут выведены следующие результаты (правая часть рисунка):
Теперь давайте аналогично заполним лист "Расходы", добавим в модуль 2 следующий код и запустим его на выполнение:
Sub РасходыПомесячно()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strFile As String, strCon As String, strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Integer
Set wb = ThisWorkbook
Call connectM(cn, rs, strFile, strCon, wb)
Set ws = wb.Worksheets("ОтчетРасходы")
ws.UsedRange.Clear
strSQL = "SELECT dateserial(year(Дата), month(Дата),1), SUM(сумма) " & _
"FROM [Расходы$] " & _
"GROUP BY dateserial(year(Дата), month(Дата),1)"
rs.Open strSQL, cn
With ws
.Cells(1, 1) = "Месяц"
.Cells(1, 2) = "Расходы"
End With
i = 2
While Not rs.EOF
If Not IsNull(rs.Fields(0)) = True Then
ws.Cells(i, 1) = CDate(rs.Fields(0))
ws.Cells(i, 2) = (rs.Fields(1))
i = i + 1
End If
rs.MoveNext
Wend
Set rs = Nothing
Set cn = Nothing
End Sub
Получим следующий результат
Теперь у нас есть два листа, в которые помесячно собираются данные о суммах расходов и доходов - это листы "ОтчетДоходы" и "ОтчетРасходы".
Теперь мы выведем на лист "ДоходыРасходыМесяц" данные, на которых будем видеть сколько мы получили доходов, сколько потратили и остаток от их разницы, кроме того добавим столбец "Прошлый месяц", с помощью которого будем в последующем выводить суммы, которые были у нас на начало месяца.
Вставляйте этот код в модуль 2 и запускайте его на выполнение
Sub АнализПомесячно()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strFile As String, strCon As String, strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Integer
Set wb = ThisWorkbook
Call connectM(cn, rs, strFile, strCon, wb)
Set ws = wb.Worksheets("ДоходыРасходыМесяц")
ws.UsedRange.Clear
strSQL = "SELECT A.Дата, B.Доходы as Доходы, C.Расходы as Расходы, dateadd(" & Chr(34) & "m" & Chr(34) & ",-1,A.Дата), iif(isnull(Доходы)=true,0,Доходы) - iif(isnull(Расходы)=true,0,Расходы) " & _
"FROM ([Даты$] as A " & _
"LEFT JOIN [ОтчетДоходы$] as B ON A.Дата = B.Месяц) " & _
"LEFT JOIN [ОтчетРасходы$] as C ON A.Дата = C.Месяц " & _
"WHERE day(A.Дата) = 1"
rs.Open strSQL, cn
With ws
.Cells(1, 1) = "Месяц"
.Cells(1, 2) = "Доходы"
.Cells(1, 3) = "Расходы"
.Cells(1, 4) = "Остаток"
.Cells(1, 5) = "ПрошлыйМесяц"
End With
i = 2
While Not rs.EOF
If Not IsNull(rs.Fields(0)) = True Then
ws.Cells(i, 1) = CDate(rs.Fields(0))
If IsNull((rs.Fields(1))) = False Then
ws.Cells(i, 2) = CCur(rs.Fields(1))
Else
ws.Cells(i, 2) = 0
End If
If IsNull((rs.Fields(2))) = False Then
ws.Cells(i, 3) = CCur(rs.Fields(2))
Else
ws.Cells(i, 3) = 0
End If
ws.Cells(i, 5) = CDate(rs.Fields(3))
If IsNull((rs.Fields(4))) = False Then
ws.Cells(i, 4) = CCur(rs.Fields(4))
Else
ws.Cells(i, 4) = 0
End If
i = i + 1
End If
rs.MoveNext
Wend
Set rs = Nothing
Set cn = Nothing
End Sub
В результате мы получим следующий результат
Как мы видим, на лист "ДоходыРасходыМесяц" с помощью SQL запроса мы собрали суммы всех доходов и расходов за каждый месяц и вычислили разницу между доходами и расходами.
Теперь соберем отдельно на лист "ОстаткиМесяц" результаты суммирования остатков по месяцам.
Копируйте и запускайте следующий код:
Sub ОстаткиМесяц()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strFile As String, strCon As String, strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Integer
Set wb = ThisWorkbook
Call connectM(cn, rs, strFile, strCon, wb)
Set ws = wb.Worksheets("ОстаткиМесяц")
ws.UsedRange.Clear
strSQL = "SELECT [Даты$].Дата, Sum([ДоходыРасходыМесяц$].Остаток) " & _
"FROM [Даты$], [ДоходыРасходыМесяц$] " & _
"WHERE day([Даты$].Дата) = 1 AND [ДоходыРасходыМесяц$].Месяц <= [Даты$].Дата " & _
"GROUP BY [Даты$].Дата"
rs.Open strSQL, cn
With ws
.Cells(1, 1) = "Даты"
.Cells(1, 2) = "Остаток"
End With
i = 2
While Not rs.EOF
If Not IsNull(rs.Fields(0)) = True Then
ws.Cells(i, 1) = CDate(rs.Fields(0))
If IsNull((rs.Fields(1))) = False Then
ws.Cells(i, 2) = CCur(rs.Fields(1))
Else
ws.Cells(i, 2) = 0
End If
i = i + 1
End If
rs.MoveNext
Wend
Set rs = Nothing
Set cn = Nothing
End Sub
Получаем следующий результат
Теперь, если у Вас при запуске всех кодов не возникает ошибок, вы можете скрыть вспомогательные листы: Даты; ОтчетДоходы; ОтчетРасходы; ДоходыРасходыМесяц и ОстаткиМесяц.
На трех листах будут примерно такие данные, а на четвертом листе "АнализПоМесяцам" пока пусто.
Копируйте в модуль 2 код и запускайте его:
Sub ИтогАнализ()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strFile As String, strCon As String, strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Integer
Set wb = ThisWorkbook
If wb.Worksheets("Доходы").Cells(1, 1).CurrentRegion.Rows.Count < 2 Then
MsgBox "Нужно ввести записи о доходах"
Exit Sub
Else
If wb.Worksheets("Расходы").Cells(1, 1).CurrentRegion.Rows.Count < 2 Then
MsgBox "Нужно ввести записи о расходах"
Exit Sub
End If
End If
Call connectM(cn, rs, strFile, strCon, wb)
Call ДоходыПомесячно
Call РасходыПомесячно
Call АнализПомесячно
Call ОстаткиМесяц
' Call АнализРасходов
Set ws = wb.Worksheets("АнализПоМесяцам")
strSQL = "SELECT [ДоходыРасходыМесяц$].Месяц, [ОстаткиМесяц$].Остаток, [ДоходыРасходыМесяц$].Доходы, [ДоходыРасходыМесяц$].Расходы, " & _
"IIF(IsNull([ОстаткиМесяц$].Остаток)=true,0,[ОстаткиМесяц$].Остаток) + IIF(IsNull([ДоходыРасходыМесяц$].Доходы)=true,0,[ДоходыРасходыМесяц$].Доходы) - IIF(IsNull([ДоходыРасходыМесяц$].Расходы)=true,0,[ДоходыРасходыМесяц$].Расходы) " & _
"FROM [ДоходыРасходыМесяц$] " & _
"LEFT JOIN [ОстаткиМесяц$] ON [ДоходыРасходыМесяц$].ПрошлыйМесяц = [ОстаткиМесяц$].Даты"
rs.Open strSQL, cn
With ws
.Cells(1, 1) = "Даты"
.Cells(1, 2) = "СуммаНачало"
.Cells(1, 3) = "Доходы"
.Cells(1, 4) = "Расходы"
.Cells(1, 5) = "Остаток"
End With
i = 2
While Not rs.EOF
If Not IsNull(rs.Fields(0)) = True Then
ws.Cells(i, 1) = Format(CDate(rs.Fields(0)), "mmmm yyyy")
If IsNull((rs.Fields(1))) = False Then
ws.Cells(i, 2) = CCur(rs.Fields(1))
Else
ws.Cells(i, 2) = 0
End If
If IsNull((rs.Fields(2))) = False Then
ws.Cells(i, 3) = CCur(rs.Fields(2))
Else
ws.Cells(i, 3) = 0
End If
If IsNull((rs.Fields(3))) = False Then
ws.Cells(i, 4) = CCur(rs.Fields(3))
Else
ws.Cells(i, 4) = 0
End If
If IsNull((rs.Fields(4))) = False Then
ws.Cells(i, 5) = CCur(rs.Fields(4))
Else
ws.Cells(i, 5) = 0
End If
i = i + 1
End If
rs.MoveNext
Wend
Set rs = Nothing
Set cn = Nothing
End Sub
Теперь вы получили анализ своих доходов и расходов по месяцам.
Как вы видите до января 2023 года у нас не было ни доходов ни расходов, поэтому в столбце СуммаНачало стоит 0 рублей, затем мы получили (планируем получить) 70 000 рублей дохода и потратить 29 700 рублей и по итогу месяца у нас останется 40 300 рублей. И так в каждом месяце, что показывает нам как будут обстоять наши финансовые дела каждый месяц.
Следующим шагом, на этот лист мы выведем наши затраты, сгруппированные по категориям. Для этого копируем и запускаем следующий код:
Sub ГруппировкаРасходов()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strFile As String, strCon As String, strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Integer
Dim dt As Date
Set wb = ThisWorkbook
Set ws = wb.Worksheets("АнализПоМесяцам")
dt = CDate(ws.Cells(Selection.Row, 1))
With ws
.Cells(1, 10).Resize(100, 5).Clear
End With
Call connectM(cn, rs, strFile, strCon, wb)
strSQL = "SELECT DateSerial(Year(A.Дата),Month(A.Дата),1) AS ДатаНачМес, A.Категория, SUM(A.Сумма) AS Всего, SUM(IIF(A.Подтверждение,A.Сумма,0)) AS Потрачено, SUM(IIF(A.Подтверждение,0,A.Сумма)) AS Потратить " & _
"FROM [Расходы$] as A " & _
"WHERE Year(A.Дата)=Year(#" & Month(dt) & "/" & Day(dt) & "/" & Year(dt) & "#) And Month(A.Дата)=Month(#" & Month(dt) & "/" & Day(dt) & "/" & Year(dt) & "#) " & _
"GROUP BY A.Категория, DateSerial(Year(A.Дата),Month(A.Дата),1)"
rs.Open strSQL, cn
With ws
.Cells(Selection.Row, 10) = "Даты"
.Cells(Selection.Row, 11) = "Категория"
.Cells(Selection.Row, 12) = "Всего"
.Cells(Selection.Row, 13) = "Потрачено"
.Cells(Selection.Row, 14) = "Потратить"
End With
i = Selection.Row + 1
While Not rs.EOF
If Not IsNull(rs.Fields(0)) = True Then
ws.Cells(i, 10) = Format(CDate(rs.Fields(0)), "mmmm yyyy")
If IsNull((rs.Fields(1))) = False Then
ws.Cells(i, 11) = (rs.Fields(1))
Else
ws.Cells(i, 11) = 0
End If
If IsNull((rs.Fields(2))) = False Then
ws.Cells(i, 12) = CCur(rs.Fields(2))
Else
ws.Cells(i, 12) = 0
End If
If IsNull((rs.Fields(3))) = False Then
ws.Cells(i, 13) = CCur(rs.Fields(3))
Else
ws.Cells(i, 13) = 0
End If
If IsNull((rs.Fields(4))) = False Then
ws.Cells(i, 14) = CCur(rs.Fields(4))
Else
ws.Cells(i, 14) = 0
End If
i = i + 1
End If
rs.MoveNext
Wend
With ws.Cells(Selection.Row, 10).CurrentRegion
ActiveSheet.ListObjects.Add(xlSrcRange, Range(.Address), , xlYes).Name = _
"Таблица10"
ActiveSheet.ListObjects("Таблица10").TableStyle = "TableStyleMedium10"
ActiveSheet.ListObjects("Таблица10").ShowTotals = True
ActiveSheet.ListObjects("Таблица10").ListColumns("Потрачено").TotalsCalculation _
= xlTotalsCalculationSum
ActiveSheet.ListObjects("Таблица10").ListColumns("Всего").TotalsCalculation = _
xlTotalsCalculationSum
End With
Set rs = Nothing
Call ГруппировкаДоходов
End Sub
Sub ГруппировкаДоходов()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strFile As String, strCon As String, strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Integer
Dim dt As Date
Set wb = ThisWorkbook
Set ws = wb.Worksheets("АнализПоМесяцам")
dt = CDate(ws.Cells(Selection.Row, 1))
With ws
.Cells(1, 16).Resize(100, 5).Clear
End With
Call connectM(cn, rs, strFile, strCon, wb)
strSQL = "SELECT DateSerial(Year(A.Дата),Month(A.Дата),1) AS ДатаНачМес, A.Категория, SUM(A.Сумма) AS Всего, SUM(IIF(A.Подтверждение,A.Сумма,0)) AS Получено, SUM(IIF(A.Подтверждение,0,A.Сумма)) AS Получить " & _
"FROM [Доходы$] as A " & _
"WHERE Year(A.Дата)=Year(#" & Month(dt) & "/" & Day(dt) & "/" & Year(dt) & "#) And Month(A.Дата)=Month(#" & Month(dt) & "/" & Day(dt) & "/" & Year(dt) & "#) " & _
"GROUP BY A.Категория, DateSerial(Year(A.Дата),Month(A.Дата),1)"
rs.Open strSQL, cn
With ws
.Cells(Selection.Row, 16) = "Даты"
.Cells(Selection.Row, 17) = "Категория"
.Cells(Selection.Row, 18) = "Всего"
.Cells(Selection.Row, 19) = "Получено"
.Cells(Selection.Row, 20) = "Получить"
End With
i = Selection.Row + 1
While Not rs.EOF
If Not IsNull(rs.Fields(0)) = True Then
ws.Cells(i, 16) = Format(CDate(rs.Fields(0)), "mmmm yyyy")
If IsNull((rs.Fields(1))) = False Then
ws.Cells(i, 17) = (rs.Fields(1))
Else
ws.Cells(i, 17) = 0
End If
If IsNull((rs.Fields(2))) = False Then
ws.Cells(i, 18) = CCur(rs.Fields(2))
Else
ws.Cells(i, 18) = 0
End If
If IsNull((rs.Fields(3))) = False Then
ws.Cells(i, 19) = CCur(rs.Fields(3))
Else
ws.Cells(i, 19) = 0
End If
If IsNull((rs.Fields(4))) = False Then
ws.Cells(i, 20) = CCur(rs.Fields(4))
Else
ws.Cells(i, 20) = 0
End If
i = i + 1
End If
rs.MoveNext
Wend
With ws.Cells(Selection.Row, 16).CurrentRegion
ActiveSheet.ListObjects.Add(xlSrcRange, Range(.Address), , xlYes).Name = _
"Таблица20"
ActiveSheet.ListObjects("Таблица20").TableStyle = "TableStyleMedium14"
ActiveSheet.ListObjects("Таблица20").ShowTotals = True
ActiveSheet.ListObjects("Таблица20").ListColumns("Получено").TotalsCalculation _
= xlTotalsCalculationSum
ActiveSheet.ListObjects("Таблица20").ListColumns("Всего").TotalsCalculation = _
xlTotalsCalculationSum
End With
Set rs = Nothing
End Sub
Результатом кода будет выведен на лист "АнализПоМесяцам"
Причем обратите внимание на то, что таблицы с расшифровками доходов и расходов будут располагаться на уровне месяца, который выделен в левой части таблицы.
Для того, чтобы видеть отклонения в ваших финансовых делах, в левой части таблицы с помощью условного форматирования можно настроить с помощью цвета шрифта и заливки выделение определенных значений, например:
- выделить красным ячейки с расходами, значения которых превышают значения доходов в этом же месяце;
- залить красным те остатки, которые меньше нуля, т.е. при определенном соотношении доходов и расходов у вас в конце месяца будет образована задолженность и т.д. и т.п.
Для того, чтобы постоянно не переходить в редактор VBA для запуска нужных процедур (ИтогАнализ и ГруппировкаРасходов), выведите их на панель быстрого доступа. Теперь вы с любого листа можете запустить процедуру ИтогАнализ, чтобы обновить информацию на листе АнализПоМесяцам и уже на этом листе вывести сгруппированные доходы и расходы за нужный вам месяц.
