Помогите создать реестр документов по данным таблицы. Данные в большую таблицу заполняются из 1с. Из них нужно на дату платежа сформировать реестр платежей за период. Данные по ИНН встают из другой таблицы с помощью впр.
Помогите создать реестр документов по данным таблицы. Данные в большую таблицу заполняются из 1с. Из них нужно на дату платежа сформировать реестр платежей за период. Данные по ИНН встают из другой таблицы с помощью впр.Олечка
Олечка, добрый день! Вариант SQL запрросом (добавил комментарии в файл и в код). Макрос повесил на кнопку на листе "Реестр оплат". Код: [vba]
Код
Sub сформировать_реестр() Dim mySQL As String, myConnect As String, myRecord As Object Dim oRange As Range, lr As Long, shName As String, i As Long, conn Set myRecord = CreateObject("ADODB.Recordset") With Worksheets("Список заявок") ' Список заявок - имя листа с исходной таблицей (поменять на нужное) lr = .Cells(.Rows.Count, 2).End(xlUp).Row ' определяем последнюю заполненную строку во 2 столбце Set oRange = .Range("B2:Q" & lr) ' помещаем диапазон в переменную shName = "[" & .Name & "$" & oRange.Address(0, 0) & "]" ' формируем строку для SQL запроса myConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source =" & ThisWorkbook.FullName & ";" & _ "Extended Properties=""Excel 12.0;HDR=YES;""" mySQL = "SELECT `Контрагент`, `ИНН`, `Документ оплаты`, `Комментарий`, " & _ "`Сумма по счету`, FORMAT(`Дата платежа`, ""dd.mm.yyyy"") FROM " & shName & "" ' запрос myRecord.Open mySQL, myConnect ' помещаем данные в набор записей End With With Worksheets("Реестр оплат") .Cells(10, 3).CopyFromRecordset myRecord ' выгружаем данные на лист Реестр оплат в 10 строку 3 столбца End With myRecord.Close Set myRecord = Nothing For Each conn In ThisWorkbook.Connections conn.Delete Next conn End Sub
[/vba]
P.S опечатки в именах листов и в названиях столбцов не допускаются. Если на другом файле не будет работать, то нужно просто скопировать имена столбцов и листов в SQL запрос из этого файла. Например: "SELECT `ИМЯ_ВАШЕГО_СТОЛБЦА` и так далее". Обратите внимание на косые кавычки в имени столбца. Их не нужно удалять. Имена столбцов идут в том же порядке, что и на листе "Реестр оплат".
Олечка, добрый день! Вариант SQL запрросом (добавил комментарии в файл и в код). Макрос повесил на кнопку на листе "Реестр оплат". Код: [vba]
Код
Sub сформировать_реестр() Dim mySQL As String, myConnect As String, myRecord As Object Dim oRange As Range, lr As Long, shName As String, i As Long, conn Set myRecord = CreateObject("ADODB.Recordset") With Worksheets("Список заявок") ' Список заявок - имя листа с исходной таблицей (поменять на нужное) lr = .Cells(.Rows.Count, 2).End(xlUp).Row ' определяем последнюю заполненную строку во 2 столбце Set oRange = .Range("B2:Q" & lr) ' помещаем диапазон в переменную shName = "[" & .Name & "$" & oRange.Address(0, 0) & "]" ' формируем строку для SQL запроса myConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source =" & ThisWorkbook.FullName & ";" & _ "Extended Properties=""Excel 12.0;HDR=YES;""" mySQL = "SELECT `Контрагент`, `ИНН`, `Документ оплаты`, `Комментарий`, " & _ "`Сумма по счету`, FORMAT(`Дата платежа`, ""dd.mm.yyyy"") FROM " & shName & "" ' запрос myRecord.Open mySQL, myConnect ' помещаем данные в набор записей End With With Worksheets("Реестр оплат") .Cells(10, 3).CopyFromRecordset myRecord ' выгружаем данные на лист Реестр оплат в 10 строку 3 столбца End With myRecord.Close Set myRecord = Nothing For Each conn In ThisWorkbook.Connections conn.Delete Next conn End Sub
[/vba]
P.S опечатки в именах листов и в названиях столбцов не допускаются. Если на другом файле не будет работать, то нужно просто скопировать имена столбцов и листов в SQL запрос из этого файла. Например: "SELECT `ИМЯ_ВАШЕГО_СТОЛБЦА` и так далее". Обратите внимание на косые кавычки в имени столбца. Их не нужно удалять. Имена столбцов идут в том же порядке, что и на листе "Реестр оплат".jun
Ещё вариант (с запросом у пользователя периода в днях за который требуется получить отчет) Код: [vba]
Код
Sub сформировать_реестр() Dim mySQL As String, myConnect As String, myRecord As Object Dim oRange As Range, lr As Long, shName As String, conn, date_diff As Date, curr_date As Date Set myRecord = CreateObject("ADODB.Recordset")
date_diff = Application.InputBox("Введите период в днях за который требуется получить отчет", Type:=1) curr_date = Format(Now, "dd.mm.yyyy") date_diff = Format(curr_date - date_diff, "dd.mm.yyyy")
With Worksheets("Список заявок") ' Список заявок - имя листа с исходной таблицей (поменять на нужное) lr = .Cells(.Rows.Count, 2).End(xlUp).Row ' определяем последнюю заполненную строку во 2 столбце Set oRange = .Range("B2:Q" & lr) ' помещаем диапазон в переменную shName = "[" & .Name & "$" & oRange.Address(0, 0) & "]" ' формируем строку для SQL запроса myConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source =" & ThisWorkbook.FullName & ";" & _ "Extended Properties=""Excel 12.0;HDR=YES;""" mySQL = "SELECT `Контрагент`, `ИНН`, `Документ оплаты`, `Комментарий`, " & _ "`Сумма по счету`, FORMAT(`Дата платежа`, ""dd.mm.yyyy"") FROM " & shName & " " & _ "WHERE CLng(`Дата платежа`) BETWEEN " & CLng(date_diff) & " AND " & CLng(curr_date) & "" myRecord.Open mySQL, myConnect ' помещаем данные в набор записей End With With Worksheets("Реестр оплат") .Cells(10, 3).CopyFromRecordset myRecord ' выгружаем данные на лист Реестр оплат в 10 строку 3 столбца End With myRecord.Close Set myRecord = Nothing For Each conn In ThisWorkbook.Connections conn.Delete Next conn End Sub
[/vba] Отдельное спасибо Hugo за интересный подход в сравнении дат, как числовых значений
Ещё вариант (с запросом у пользователя периода в днях за который требуется получить отчет) Код: [vba]
Код
Sub сформировать_реестр() Dim mySQL As String, myConnect As String, myRecord As Object Dim oRange As Range, lr As Long, shName As String, conn, date_diff As Date, curr_date As Date Set myRecord = CreateObject("ADODB.Recordset")
date_diff = Application.InputBox("Введите период в днях за который требуется получить отчет", Type:=1) curr_date = Format(Now, "dd.mm.yyyy") date_diff = Format(curr_date - date_diff, "dd.mm.yyyy")
With Worksheets("Список заявок") ' Список заявок - имя листа с исходной таблицей (поменять на нужное) lr = .Cells(.Rows.Count, 2).End(xlUp).Row ' определяем последнюю заполненную строку во 2 столбце Set oRange = .Range("B2:Q" & lr) ' помещаем диапазон в переменную shName = "[" & .Name & "$" & oRange.Address(0, 0) & "]" ' формируем строку для SQL запроса myConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source =" & ThisWorkbook.FullName & ";" & _ "Extended Properties=""Excel 12.0;HDR=YES;""" mySQL = "SELECT `Контрагент`, `ИНН`, `Документ оплаты`, `Комментарий`, " & _ "`Сумма по счету`, FORMAT(`Дата платежа`, ""dd.mm.yyyy"") FROM " & shName & " " & _ "WHERE CLng(`Дата платежа`) BETWEEN " & CLng(date_diff) & " AND " & CLng(curr_date) & "" myRecord.Open mySQL, myConnect ' помещаем данные в набор записей End With With Worksheets("Реестр оплат") .Cells(10, 3).CopyFromRecordset myRecord ' выгружаем данные на лист Реестр оплат в 10 строку 3 столбца End With myRecord.Close Set myRecord = Nothing For Each conn In ThisWorkbook.Connections conn.Delete Next conn End Sub
[/vba] Отдельное спасибо Hugo за интересный подход в сравнении дат, как числовых значений jun
Ну дата это и есть число (количество дней от первого дня), если даты будут на листе как даты то думаю они так в макросе в запросе и будут фигурировать. Если они будут как текст, или например "01.08.2023 - 10.08.2023" тогда будем эту строку обрабатывать.
Ну дата это и есть число (количество дней от первого дня), если даты будут на листе как даты то думаю они так в макросе в запросе и будут фигурировать. Если они будут как текст, или например "01.08.2023 - 10.08.2023" тогда будем эту строку обрабатывать.Hugo
Пишите эти даты белым шрифтом в две ячейки, используйте в запросе (пример в общем выше уже есть как внедрить значение в строку). А в форму можете писать как угодно, можно формировать эту строку из этих двух ячеек формулой. Сейчас... Всёж не берёт с листа ячейку с датой как число, пришлось принудительно заставить... Сделал шрифт сереньким, в рабочем под печать можно или задать чёрно-белую печать, или шрифт сделать совсем белым.
Пишите эти даты белым шрифтом в две ячейки, используйте в запросе (пример в общем выше уже есть как внедрить значение в строку). А в форму можете писать как угодно, можно формировать эту строку из этих двух ячеек формулой. Сейчас... Всёж не берёт с листа ячейку с датой как число, пришлось принудительно заставить... Сделал шрифт сереньким, в рабочем под печать можно или задать чёрно-белую печать, или шрифт сделать совсем белым.Hugo
Ну код написал jun, ему спасибо )) Я поленился так много писать, правда я бы делал на массиве (или просто перебором ячеек) и там писать меньше, но писать ))
Ну код написал jun, ему спасибо )) Я поленился так много писать, правда я бы делал на массиве (или просто перебором ячеек) и там писать меньше, но писать ))Hugo
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
