Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Создать реестр платежей из массива данных на дату - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Создать реестр платежей из массива данных на дату
Олечка Дата: Воскресенье, 23.07.2023, 14:01 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

2019
Помогите создать реестр документов по данным таблицы.
Данные в большую таблицу заполняются из 1с. Из них нужно на дату платежа сформировать реестр платежей за период.
Данные по ИНН встают из другой таблицы с помощью впр.
К сообщению приложен файл: reestr_platezhej_kopija.xlsx (88.5 Kb)
 
Ответить
СообщениеПомогите создать реестр документов по данным таблицы.
Данные в большую таблицу заполняются из 1с. Из них нужно на дату платежа сформировать реестр платежей за период.
Данные по ИНН встают из другой таблицы с помощью впр.

Автор - Олечка
Дата добавления - 23.07.2023 в 14:01
jun Дата: Воскресенье, 23.07.2023, 17:15 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 142
Репутация: 42 ±
Замечаний: 0% ±

Олечка, добрый день!
Вариант 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 `ИМЯ_ВАШЕГО_СТОЛБЦА` и так далее". Обратите внимание на косые кавычки в имени столбца. Их не нужно удалять.
Имена столбцов идут в том же порядке, что и на листе "Реестр оплат".
К сообщению приложен файл: reestr_platezhej_kopija.xlsb (36.7 Kb)


Сообщение отредактировал jun - Воскресенье, 23.07.2023, 17:15
 
Ответить
СообщениеОлечка, добрый день!
Вариант 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
Дата добавления - 23.07.2023 в 17:15
Олечка Дата: Воскресенье, 23.07.2023, 17:33 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

2019
jun, отлично, все работает. hands
Возможно ли создать условие для заполнения по дате платежа за период, например 7 дней?
 
Ответить
Сообщениеjun, отлично, все работает. hands
Возможно ли создать условие для заполнения по дате платежа за период, например 7 дней?

Автор - Олечка
Дата добавления - 23.07.2023 в 17:33
Hugo Дата: Воскресенье, 23.07.2023, 19:44 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3255
Репутация: 707 ±
Замечаний: 0% ±

2019
Так будет за один день - 01.08.2023:
[vba]
Код
    mySQL = "SELECT `Контрагент`, `ИНН`, `Документ оплаты`, `Комментарий`, " & _
    "`Сумма по счету`, FORMAT(`Дата платежа`, ""dd.mm.yyyy"") FROM " & shName & " where `Дата платежа` = 45139" ' запрос
[/vba]
А так период:
[vba]
Код
    mySQL = "SELECT `Контрагент`, `ИНН`, `Документ оплаты`, `Комментарий`, " & _
    "`Сумма по счету`, FORMAT(`Дата платежа`, ""dd.mm.yyyy"") FROM " & shName & " where `Дата платежа` > 45138 and `Дата платежа` < 45149" ' запрос
[/vba]
Вам нужно придумать как дать этот период (какой, как укажете макросу эти даты).


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Воскресенье, 23.07.2023, 19:49
 
Ответить
СообщениеТак будет за один день - 01.08.2023:
[vba]
Код
    mySQL = "SELECT `Контрагент`, `ИНН`, `Документ оплаты`, `Комментарий`, " & _
    "`Сумма по счету`, FORMAT(`Дата платежа`, ""dd.mm.yyyy"") FROM " & shName & " where `Дата платежа` = 45139" ' запрос
[/vba]
А так период:
[vba]
Код
    mySQL = "SELECT `Контрагент`, `ИНН`, `Документ оплаты`, `Комментарий`, " & _
    "`Сумма по счету`, FORMAT(`Дата платежа`, ""dd.mm.yyyy"") FROM " & shName & " where `Дата платежа` > 45138 and `Дата платежа` < 45149" ' запрос
[/vba]
Вам нужно придумать как дать этот период (какой, как укажете макросу эти даты).

Автор - Hugo
Дата добавления - 23.07.2023 в 19:44
jun Дата: Воскресенье, 23.07.2023, 20:35 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 142
Репутация: 42 ±
Замечаний: 0% ±

Ещё вариант (с запросом у пользователя периода в днях за который требуется получить отчет)
Код:
[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 за интересный подход в сравнении дат, как числовых значений :)
К сообщению приложен файл: 5552532.xlsb (40.0 Kb)


Сообщение отредактировал jun - Воскресенье, 23.07.2023, 20:45
 
Ответить
СообщениеЕщё вариант (с запросом у пользователя периода в днях за который требуется получить отчет)
Код:
[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
Дата добавления - 23.07.2023 в 20:35
Hugo Дата: Воскресенье, 23.07.2023, 20:55 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3255
Репутация: 707 ±
Замечаний: 0% ±

2019
Ну дата это и есть число (количество дней от первого дня), если даты будут на листе как даты то думаю они так в макросе в запросе и будут фигурировать.
Если они будут как текст, или например "01.08.2023 - 10.08.2023" тогда будем эту строку обрабатывать.


excel@nxt.ru
webmoney: E265281470651 Z422237915069
 
Ответить
СообщениеНу дата это и есть число (количество дней от первого дня), если даты будут на листе как даты то думаю они так в макросе в запросе и будут фигурировать.
Если они будут как текст, или например "01.08.2023 - 10.08.2023" тогда будем эту строку обрабатывать.

Автор - Hugo
Дата добавления - 23.07.2023 в 20:55
Олечка Дата: Воскресенье, 23.07.2023, 21:44 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

2019
Hugo, да именно по запросу дат , например, "01.08.2023 - 10.08.2023", нужно
 
Ответить
СообщениеHugo, да именно по запросу дат , например, "01.08.2023 - 10.08.2023", нужно

Автор - Олечка
Дата добавления - 23.07.2023 в 21:44
Hugo Дата: Воскресенье, 23.07.2023, 21:49 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3255
Репутация: 707 ±
Замечаний: 0% ±

2019
Пишите эти даты белым шрифтом в две ячейки, используйте в запросе (пример в общем выше уже есть как внедрить значение в строку).
А в форму можете писать как угодно, можно формировать эту строку из этих двух ячеек формулой.
Сейчас...
Всёж не берёт с листа ячейку с датой как число, пришлось принудительно заставить...
Сделал шрифт сереньким, в рабочем под печать можно или задать чёрно-белую печать, или шрифт сделать совсем белым.
К сообщению приложен файл: sql_zapros_period_dat_reestr_p.xlsb (38.6 Kb)


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Воскресенье, 23.07.2023, 21:59
 
Ответить
СообщениеПишите эти даты белым шрифтом в две ячейки, используйте в запросе (пример в общем выше уже есть как внедрить значение в строку).
А в форму можете писать как угодно, можно формировать эту строку из этих двух ячеек формулой.
Сейчас...
Всёж не берёт с листа ячейку с датой как число, пришлось принудительно заставить...
Сделал шрифт сереньким, в рабочем под печать можно или задать чёрно-белую печать, или шрифт сделать совсем белым.

Автор - Hugo
Дата добавления - 23.07.2023 в 21:49
Олечка Дата: Воскресенье, 23.07.2023, 22:09 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

2019
Hugo, супер, все работает. Спасибо огромное thumb
 
Ответить
СообщениеHugo, супер, все работает. Спасибо огромное thumb

Автор - Олечка
Дата добавления - 23.07.2023 в 22:09
Hugo Дата: Воскресенье, 23.07.2023, 22:11 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3255
Репутация: 707 ±
Замечаний: 0% ±

2019
Ну код написал jun, ему спасибо ))
Я поленился так много писать, правда я бы делал на массиве (или просто перебором ячеек) и там писать меньше, но писать ))


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Воскресенье, 23.07.2023, 22:12
 
Ответить
СообщениеНу код написал jun, ему спасибо ))
Я поленился так много писать, правда я бы делал на массиве (или просто перебором ячеек) и там писать меньше, но писать ))

Автор - Hugo
Дата добавления - 23.07.2023 в 22:11
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!