Целью этого проекта изначально было разнесение позиций банковской выписки выгруженной из бухгалтерской программы АСФУ по специальным финансовым позициям. Программа разделена на два файла – «Надходження» и «Витрати», соответственно для ведения доходных и расходных позиций. Полностью реализована в экселе (.xlsm) с помощью стандартных формул, фильтров и, может быть, не совсем стандартных макросов.
От любой другой самодельной таблички, которая бы могла выполнять хоть в какой-то мере указанную роль, этот проект отличается тем что:
Помимо этого, добавлена тесная интеграция к программам АСФУ и SAP. Из АСФУ в экселевском файле экспортируется выписка, далее эту выписку импортируем в наш проект, кликнув лишь раз по кнопке «Импорт», после чего макрос определит какой расчетный счет и какой именно диапазон ячеек нужно скопировать. Список финансовых позиций подогнан к тем, которые используются в программе SAP, и, выгрузив экселевский файл из модуля «Реестр заявок», достаточно просто автоматизировать разноску выписки кликнув по кнопке «Полу-автомат», то есть, макрос самостоятельно проставит соответствия выписки из двух сторонних программ по суммам.
Вся эта специфика в интеграции к двум программам вряд ли заинтересует широкого пользователя, так как в каком-то смысле является уникальной в рамках существующего предприятия. Эта статья писалась, прежде всего, для двух категорий людей:
1) Для тех, кто увидит потенциал в программе как платформе для контроля и мониторинга своих затрат, вплоть до семейного бюджета, к примеру, список финансовых позиций можно заменить списком основных категорий затрат: на одежду, еду, проезд, развлечения и т.д. и т.п., а список расчетных счетов можно заменить членами семьи – Саша, Петя, Света, Аня и т.п.
2) Для тех, кто преследует схожую задачу – создание среды для ведения и разнесения банковской выписки на предприятии, также как и для тех, кто попадет на статью в поисках программного решения какого-то конкретного процесса используемого в этой программе для реализации какого-то совсем другого проекта, далее будет расписан исходный код и принцип действия макросов.
Как уже было написано выше, проект «банковская выписка» состоит из двух файлов, в которых отдельно ведется и фиксируется движение поступлений и затрат. Принцип действия обеих файлов одинаковый, лишь файл для ведения затрат более сложнее из-за наличия интеграции с программой SAP через макрос «ПолуАвтомат», поэтому будем рассматривать структуру на примере именно этого файла.
В качестве места для опционных настроек выступают листы «Бібліотека рахунків» и «Бібліотека ФП», отсюда подтягиваются данные о возможных вариантах финансовых позиций или расчетных счетов и здесь же их можно отредактировать, если есть такая необходимость.
Лист с названием «DataBase» – это база данных, в которой сохраняются результаты разнесенной выписки и из которой подтягиваются данные для просмотра.
Далее следуют листы, наименованиями которых являются даты, это «рабочие лошадки» именно здесь и происходит все самое интересное – в каждый такой лист импортируется выписка из АСФУ (или клиент-банка) и здесь же для каждой записи выставляются соответствия к финансовым позициям, результаты такой работы затем сохраняются в базе данных, то есть в листе «DataBase».
Наконец, лист «Головна книга» - это тот лист, который позволяет посмотреть результаты работы «банковской выписки» для последующего анализа или даже прогноза, если хотите, сюда в соответствии с фильтрами дат и типов счетов подтягиваются данные из листа «DataBase».
Про то, как реализованы выпадающие списки и использованы формулы для подтягивания данных по типу ВПР и СУММЕСЛИ, комбинации логических условий через формулы ЕСЛИ, обрезание и склеивание текста в ячейках и прочие решения через стандартные формулы и фильтры в Экселе, расписывать не буду, потому как каждый из таких вопросов требует либо отдельной полноценной статьи, либо вообще ничего.
"Воспетыми" останутся только макросы, каждый из них будет назван, описано его назначение и выложен исходный код с комментариями.
Листы непосредственно с выписками, копируются (дублируются) с предыдущей даты, после чего обновляется вручную название листа и ячейка с датой к той дате, за которую планируется разносить выписку. Плюсом такого дублирования является сохранение структуры таблиц, стилей и необходимых кнопок для запуска макросов, а минус в том, что остаются данные выписки из того дня, который копировали, поэтому эти данные здесь явно неактуальны. Очистить их можно вручную, выделяя диапазоны незащищенных от изменений ячеек и нажимая кнопку Delete, но лично я предпочел перепоручить это «сложное дело» макросу.
Sub Очистить()
'задаем переменную
Dim iLastRowMe As Long
'определяем номер строки, в которой есть хоть какие-то данные, ориентируясь на третий столбец
iLastRowMe = Cells(Rows.Count, 3).End(xlUp).Row
'далее используем полученный номер строки как конечную координату диапазона, который необходимо выделить и затем очистить
If iLastRowMe >= 8 Then
'так как столбец D защищен от изменений, чтобы случайно не стерлась формула, то выделяем и очищаем по два диапазона, до столбца D и после
Range("B8:C" & iLastRowMe).Select
Selection.ClearContents
Range("E8:G" & iLastRowMe).Select
Selection.ClearContents
Else
'чтобы случайно не стереть шапку таблицы с заголовками в случае, если повторно запустили макрос или по какой-либо другой причине отсутствуют данные, добавлено условие If для переменной iLastRowMe, которое по сути этот момент и исправляет.
iLastRowMe = 8
Range("B8:C" & iLastRowMe).Select
Selection.ClearContents
Range("E8:G" & iLastRowMe).Select
Selection.ClearContents
End If
End Sub
На предприятии выписка выгружается из программы АСФУ в экселевские файлы в виде табличек с шаблонной структурой (пример такой выписки также прилагается к статье). Копировать ячейки с сумами и описанием каждой суммы можно вручную, но зачем, когда и это можно поручить макросу? Макрос сам определит полезные ячейки, скопирует их значения и перенесет в необходимые столбцы на лист в наш проект «банковской выписки» для последующей обработки.
Sub Импорт()
'задаем перечень и тип переменных
Dim WS1 As Excel.Worksheet
Dim WB As Workbook
Dim iLastRowMe, iLastLastRowMe As Long
Dim ListNameMe, ListNameYou, Rahunok As String
'определение переменных (см. статью о функции GetAnotherWorkbook)
Set WS1 = ActiveWorkbook.ActiveSheet
Set WB = GetAnotherWorkbook
ListNameMe = WS1.Name
'определяем номер строки последней используемой ячейки в файле с проектом «банковская выписка», далее «материнский файл»
iLastRowMe = Cells(Rows.Count, 3).End(xlUp).Row
'и прибавляем к нему единицу, чтобы далее использовать переменную как начальную координату диапазона, куда вставлять скопированные данные.
iLastRowMe = iLastRowMe + 1
'Переключаемся на файл с выгруженной выпиской – исходными данными
WB.Activate
'Определяем тип счета, просматривая через условие наличие отличительного кода расчетного счета и если условие срабатывает, то переменная Rahunok приравнивается текстовому наименованию счета
If Range("A3").Value Like "*311.1*" Then
Rahunok = "Розрахунковий"
End If
If Range("A3").Value Like "*311.2*" Then
Rahunok = "Податковий"
End If
If Range("A3").Value Like "*311.3*" Then
Rahunok = "Переказний"
End If
If Range("A3").Value Like "*311.4*" Then
Rahunok = "Соціальний"
End If
If Range("A3").Value Like "*312.3*" Then
Rahunok = "Євро"
End If
If Range("A3").Value Like "*312.2*" Then
Rahunok = "Долар"
End If
'В текущем файле в столбце B найдем первое попавшееся значение равное нулю, и определим номер строки такой ячейки как переменную xEnd
On Error Resume Next
Dim xEnd As Long
xEnd = Range("B10:B750").Find("0.00", , xlValues, 1, , , 0, 0).Row
'с помощью простого условия предопределим тот случай, если в выписке за день не будет движения по расходам
If xEnd = 10 Then
WB.Range("A1").Select
MsgBox "В выписке за текущий день нет движения по расходам, нечего импортировать."
Else
'Если движение все-таки есть, то есть смысл переменную xEnd использовать как конечную координату диапазона копируемых данных, правда для этого номер строки нужно подтянуть вверх, отминусовав от него единицу.
xEnd = xEnd - 1
'Копируем диапазон сумм относящихся в выписке к затратам (для валютных счетов это столбец C, для всех остальных – столбец B), используя переменную xEnd
If Range("A3").Value Like "*312.3*" Or Range("A3").Value Like "*312.2*" Then
Range("C10:C" & xEnd).Select
Selection.Copy
Else
Range("B10:B" & xEnd).Select
Selection.Copy
End If
'Переключаемся на материнский файл, активируем первую неиспользуемую ячейку в столбце С ориентируясь на переменную iLastRowMe и вставляем скопированные данные, используя специальную вставку - значения
WS1.Activate
Range("C" & iLastRowMe).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Опять переключаемся на файл с исходными данными и копируем информацию о наименовании контрагентов и назначение платежей соответствующим скопированным ранее перечню платежей
WB.Activate
'Для валютных счетов необходимые данные находятся в столбцах F и G, а во всех остальных – D и E
If Range("A3").Value Like "*312.3*" Or Range("A3").Value Like "*312.2*" Then
Range("F10:G" & xEnd).Select
Selection.Copy
Else
Range("D10:E" & xEnd).Select
Selection.Copy
End If
'возвращаемся к материнскому файлу и по аналогии с предыдущим разом вставляем скопированные данные, только активируем уже в столбец F
WS1.Activate
Range("F" & iLastRowMe).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'определяем номер последней заполненной строки в третьем столбце уже после копирования данных
iLastLastRowMe = Cells(Rows.Count, 3).End(xlUp).Row
'Ставим и «протягиваем» тип счета во второй столбец из переменной Rahunok, оперируя с диапазоном который начинается с iLastRowMe и заканчивается iLastLastRowMe
Range("B" & iLastRowMe).Value = Rahunok
Range("B" & iLastRowMe).Select
Selection.AutoFill Destination:=Range("B" & iLastRowMe & ":B" & iLastLastRowMe), Type:=xlFillDefault
'Активируем верхнюю слева ячейку, чтобы поднять взор пользователя снизу листа на верх, для удобства
Range("A1").Select
End If
End Sub
Так как на предприятии реализована такая схема, при которой практически все платежи набираются в программе SAP через модуль «Реєстр заявок на платіж», а затем выгружаются в клиент-банк для осуществления оплаты, после факта оплаты из клиент-банка выгружается выписка, которую собственно и стоит задача разнести по финансовым позициям используемым в SAPе, то глупо разносить выписку вручную, если этот процесс можно автоматизировать.
Автоматизация предусматривает выгрузку в экселевском файле данных по платежам за интересующий день и впоследствии подтягивание этих данных в затратную часть банковской выписки и с помощью формул ВПР и простого копирования производится сопоставление затратных позиций и фактически разноска выписки – автоматом проставляются финансовые позиции в проекте «банковская выписка» по пересекающимся выгруженным платежам в САП.
Макрос именуется полуавтоматом лишь по той причине, что он позволяет разнести платежи, которые проходили через САП, а остальные, по типу централизованных перебросок все равно необходимо доразносить руками.
Sub ПолуАвтомат()
'прописываем список переменных и их тип
Dim WS1 As Excel.Worksheet
Dim WB As Workbook
Dim iLastRowMe, iLastRowYou As Long
Dim ListNameMe, ListNameYou As String
'определяем переменные (смотрите статью о функции GetAnotherWorkbook)
Set WS1 = ActiveWorkbook.ActiveSheet
Set WB = GetAnotherWorkbook
ListNameMe = ActiveSheet.Name
If Not WB Is Nothing Then
MsgBox "Выбрана книга: " & WB.FullName, vbInformation
ListNameYou = WB.ActiveSheet.Name
Else
MsgBox "Книга не выбрана", vbCritical: Exit Sub
End If
'------Start
'Определяем номер строки ячейки в 3 столбце, которая последняя сверху имеет хоть какое-то содержимое, в файле с банковской выпиской, далее материнском файле.
iLastRowMe = Cells(Rows.Count, 3).End(xlUp).Row
'Переключаемся на файл с исходными данными и показываем все скрытые ячейки
WB.Activate
Cells.Select
Selection.EntireRow.Hidden = False
Range("A1").Select
'определяем номер строки с последней используемой ячейкой в первом столбце в файле с исходными данными
iLastRowYou = Cells(Rows.Count, 1).End(xlUp).Row
'Возвращаемся к материнскому файлу
WS1.Activate
'выделяем тех ячейку и прописываем формулу ВПР (тянем исходные данные – финпозиции, сравнивая суммы)
Range("K8").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-8],[" & WB.Name & "]" & ListNameYou & "!R2C1:R" & iLastRowYou & "C2,2,FALSE)"
'повторно выделяем тех ячейку и протягиваем формулу до конца диапазона
Range("K8").Select
Selection.AutoFill Destination:=Range("K8:K" & iLastRowMe), Type:=xlFillDefault
'выделяем вторую тех ячейку рядом и прописываем еще одну формулу ВПР (тянем наименования финпозиций из библиотеки)
'ВНИМАНИЕ! в формуле стоит ссылка на диапазон до 200 строк в библиотеке финпозиций
Range("L8").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Á³áë³îòåêà ÔÏ'!R3C1:R200C4,4,FALSE)"
'повторно выделяем вторую тех ячейку и протягиваем формулу
Range("L8").Select
Selection.AutoFill Destination:=Range("L8:L" & iLastRowMe), Type:=xlFillDefault
'копируем вытянутые из исходника и обработанные данные, а затем вставляем их в соответствующие поля разноски выписки
Range("L8:L" & iLastRowMe).Select
Selection.Copy
Range("E8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Очищаем диапазон с тех ячейками
Range("K8:L" & iLastRowMe).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
End Sub
По моему мнению, это самый ценный из всех используемых макросов в этом проекте, так как именно он позволил реализовать именно такую архитектуру – листы для внесения и изменения данных и лист для просмотра результатов работы, связь между которыми обеспечивается с помощью листа с базой данных.
Макрос сравнивает текущую дату со всеми записями в базе данных, если находит записи с таким параметром, то удаляет их и только после этого в низу под всеми прочими записями сохраняет данные из листа с разнесенной выпиской, таким образом, обеспечивая безопасное сохранение данных, если они сохраняются в первый раз, и бесконечное количество раз пересохранений, в случае изменений данных на листе с выпиской.
Sub Del_FromBase()
'прописываем список переменных и их тип
Dim sSubStr As String 'искомое слово или фраза (может быть указанием на ячейку)
Dim lCol As Long 'номер столбца в котором будет производиться поиск
Dim lLastRow, li, PosledStroka1, PosledStroka2 As Long
Dim lMet As Long
Dim Mes As String
'Определяем переменную sSubStr как значение ячейки D4, которое содержит дату
sSubStr = ActiveSheet.Range("D4").Value
If sSubStr = "" Then lMet = 0 Else lMet = 1
lCol = 1 'определяем номер столбца в котором будет проводится сравнительный поиск по листу с базой данных
If lCol = 0 Then Exit Sub
'в кавычках указываем название листа, который выполняет роль базы данных
lLastRow = Sheets("DataBase").UsedRange.Row - 1 + Sheets("DataBase").UsedRange.Rows.Count
'Отключаем обновление экрана при выполнении цикла
Application.ScreenUpdating = 0
'Цикл обрабатывает построчно каждую запись в базе данных с самой последней до самой первой и если находит соответствие по дате и удаляет соответствующие строки
For li = lLastRow To 1 Step -1
If -(InStr(Sheets("DataBase").Cells(li, lCol), sSubStr) > 0) = lMet Then Sheets("DataBase").Rows(li).Delete
Next li
'Возвращаем обновление экрана к нормальному состоянию
Application.ScreenUpdating = 1
'на листе с выпиской определяем номер строки с последней используемой ячейкой в во втором столбце
PosledStroka1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'выделяем и копируем диапазон с данными выписки ссылаясь на переменную PosledStroka1
ActiveSheet.Range("A8:D" & PosledStroka1).Copy
'после возможного удаления строк диапазон занятых ячеек в базе данных может сдвинуться, поэтому нужно опять определить номер строки с последней используемой ячейкой в первом столбце на листе с базой данных
PosledStroka2 = Sheets("DataBase").Cells(Rows.Count, 1).End(xlUp).Row
'с помощью специальной вставки – значения, вставляем скопированные данные после всех записей в базе данных, используя для этого как координату переменную PosledStroka2
Sheets("DataBase").Range("A" & PosledStroka2 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'оповещение о завершении процесса сохранения
Mes = MsgBox("Изменения внесены", vbInformation)
End Sub
"Понемногу обо всем и все, о немногом" - именно такой слоган, по-видимому, является наилучшим определением тематики блога. Здесь пишу о том, что для меня интересно или важно, собственно, поэтому разброс тематик очень широк – от размышлений на философские темы и смешных историй, до конкретных инструкций или анализа событий.
Правда, помимо общих тематик, которые есть почти на каждом личном блоге, стоит выделить специализированные рубрики блога, которые будут полезны и интересны вебмастерам, программистам, дизайнерам, офисным работникам и пользователям ПК, желающим повысить свои навыки и уровень знаний. Подробнее о спецрубриках
Записки вебмастера – рубрика, которая призвана собрать коллекцию полезных скриптов и авторских решений, интересных особенностей и стандартов верстки, решение вопросов юзабилити и функционала, полезных ресурсов и программ.
Вопрос дизайна – это актуальные тренды, пошаговые и видео-уроки в фотошопе, необходимые плагины для фоторедакторов, векторные и PSD исходники, PNG иконки и GIF анимации, кириллические шрифты с засечками и без засечек, заливки (паттерны) и градиенты.
Мой ПК – каждая статья в этой рубрике направлена на то, чтобы узнать свой компьютер лучше. Здесь можно будет почитать о системных процессах и редактировании системного реестра, о способах защитить личные данные и компьютер в целом, о настройке локальной сети и подключениях к сети интернет, обзор ряда программ, которые делают работу за компьютером удобнее, быстрее и приятнее.
MS Office и VBA – эта рубрика содержит интересные решения, малоизвестные функции и возможности, надстройки и макросы, в общем, все то, что может сделать вашу работу в пакете программ MS Office (в первую очередь - Excel, Word, Access, PowerPoint) более эффективной.
Прочие офисные программы – рубрика о программах для ведения учета (конфигурации, платформы, внешние отчеты для 1C), сдачи отчетности (MeDoc, БестЗвіт) и статистического анализа данных (SPSS), также здесь можно найти обзоры программного обеспечения для работы с периферийными устройствами. Свернуть
P.S. В своих постах я не претендую на абсолютность точки зрения, поэтому всегда рад диалогу с читателями, посредством комментариев или любым из доступных социальных сервисов