Добрый всем! Есть входные данные: 1. На 1 листе план закупок по поставщику и категории товара; 2. На 2 листе данные по поставщику и категории товара с указанием количества недель отсрочки
Ни как не получается построить отчет по оплате закупок в аналогичной логике (поставщик-категория-неделя). Необходимо учесть данные по отсрочке платежа по контрагентам. Очень прошу помочь в решении.
Файл с данными в приложении. [admin]Файл удален по просьбе автора из-за наличия конф. информации[/admin]
Добрый всем! Есть входные данные: 1. На 1 листе план закупок по поставщику и категории товара; 2. На 2 листе данные по поставщику и категории товара с указанием количества недель отсрочки
Ни как не получается построить отчет по оплате закупок в аналогичной логике (поставщик-категория-неделя). Необходимо учесть данные по отсрочке платежа по контрагентам. Очень прошу помочь в решении.
Файл с данными в приложении. [admin]Файл удален по просьбе автора из-за наличия конф. информации[/admin]frenolon1884
Сообщение отредактировал Pelena - Среда, 23.03.2022, 19:02
frenolon1884, добрый день. Согласно логике таблиц, покупатель вынуждает ждать поставщика 21 (!) неделю, прежде чем последнему будет оплачен счет за поставленную продукцию. Где же вы видели таких терпеливых поставщиков? Возможно, в задаче имеются проблемы с единицами измерения. Алгоритм построения графика оплаты также не будет лишним....
frenolon1884, добрый день. Согласно логике таблиц, покупатель вынуждает ждать поставщика 21 (!) неделю, прежде чем последнему будет оплачен счет за поставленную продукцию. Где же вы видели таких терпеливых поставщиков? Возможно, в задаче имеются проблемы с единицами измерения. Алгоритм построения графика оплаты также не будет лишним.... NikitaDvorets
Сообщение отредактировал NikitaDvorets - Среда, 23.03.2022, 11:47
frenolon1884, прилагаю UDF (пользовательская функция) и макрос для формирования отчета по оплате из отчета по закупкам. ' пользовательская функция UDF (GetDelay) c 2 параметрами: поставщик и категория
[vba]
Код
Option Explicit Public Function GetDelay(supplier As String, category As String) As Variant Dim DelayDict As Object ' назначаем библиотеку как объект Dim i&, j& ' назначаем целые переменные i и j Dim delaykey As String ' назначаем сводную переменную delaykey для поиска Dim key As String ' назначаем переменную ключей библиотеки Dim item As String ' назначаем переменную элементов библиотеки Dim row_end, col_end As Integer ' назначаем переменные номеров последней строки и столбца в таблице можностей радиатора
Application.ScreenUpdating = False Set DelayDict = New Scripting.Dictionary 'назначаем новую библиотеку объектной переменной DelayDict
delaykey = supplier & category 'определяем сводную переменную как конкатенацию параметров: поставщик и категория
With Sheets("Отсрочка") ' для листа Отсрочка
row_end = .UsedRange.Rows.Count 'определяем последнюю строку: число заполненных строк col_end = .UsedRange.Columns.Count 'определяем последний столбец: число заполненных столбцов
For i = 2 To row_end ' цикл по строкам, начиная с 1-й занятой строки до последней занятой строки
key = .Cells(i, 5) ' определяем ключ из столбца 5 листа для библиотеки item = .Cells(i, 4) ' определяем элемент из столбца 4 листа для библиотеки DelayDict.Add key, item ' добавляем в библиотеку определенные ключи и элементы Next i ' следующая строка End With
With DelayDict 'для библиотеки If DelayDict.Exists(delaykey) Then 'если существует сводный параметр - ключ delaykey GetDelay = DelayDict.item(delaykey) ' пользовательская функция извлекает из библиотеки соответствующий ему элемент по ключу delaykey Else ' иначе GetDelay = 0 ' нет данных End If 'конец условия End With
Application.ScreenUpdating = True End Function
' макрос (create_payment_report) для переноса данных из отчета по закупкам в отчет по оплате
Public Sub create_payment_report() Dim date_cell As Date Dim Next_date As String Dim weeks_delay As Integer Dim k&, l& Dim row_end, col_end As Integer
With ActiveSheet ' активный лист ' узнать размерность массива row_end = .Cells.Find("*", [A1], xlValues, , xlByRows, xlPrevious).Row 'последняя заполненная строка col_end = .Cells.Find("*", [A1], xlValues, , xlByRows, xlPrevious).Column 'последний заполненный столбец ' переносим данные из закупок в Отчет по оплате MsgBox "Перенос данных в отчет по оплате......" For l = 5 To row_end ' цикл по строкам из таблицы Закупки weeks_delay = .Cells(l, 3).Value ' число недель отсрочки платежа For k = 1 To 12 * 4 ' в таблице Закупки 48 столбцов с датами ActiveWorkbook.Sheets("Отчет по оплате").Cells(l, 4 + k + weeks_delay - 1).Value = ActiveWorkbook.Sheets("Отчет по закупке").Cells(l, 4 + k - 1).Value Next k ' продолжаем цикл по столбцам Next l ' продолжаем цикл по строкам MsgBox "отчет по оплате сформирован" End With End Sub
[/vba]
frenolon1884, прилагаю UDF (пользовательская функция) и макрос для формирования отчета по оплате из отчета по закупкам. ' пользовательская функция UDF (GetDelay) c 2 параметрами: поставщик и категория
[vba]
Код
Option Explicit Public Function GetDelay(supplier As String, category As String) As Variant Dim DelayDict As Object ' назначаем библиотеку как объект Dim i&, j& ' назначаем целые переменные i и j Dim delaykey As String ' назначаем сводную переменную delaykey для поиска Dim key As String ' назначаем переменную ключей библиотеки Dim item As String ' назначаем переменную элементов библиотеки Dim row_end, col_end As Integer ' назначаем переменные номеров последней строки и столбца в таблице можностей радиатора
Application.ScreenUpdating = False Set DelayDict = New Scripting.Dictionary 'назначаем новую библиотеку объектной переменной DelayDict
delaykey = supplier & category 'определяем сводную переменную как конкатенацию параметров: поставщик и категория
With Sheets("Отсрочка") ' для листа Отсрочка
row_end = .UsedRange.Rows.Count 'определяем последнюю строку: число заполненных строк col_end = .UsedRange.Columns.Count 'определяем последний столбец: число заполненных столбцов
For i = 2 To row_end ' цикл по строкам, начиная с 1-й занятой строки до последней занятой строки
key = .Cells(i, 5) ' определяем ключ из столбца 5 листа для библиотеки item = .Cells(i, 4) ' определяем элемент из столбца 4 листа для библиотеки DelayDict.Add key, item ' добавляем в библиотеку определенные ключи и элементы Next i ' следующая строка End With
With DelayDict 'для библиотеки If DelayDict.Exists(delaykey) Then 'если существует сводный параметр - ключ delaykey GetDelay = DelayDict.item(delaykey) ' пользовательская функция извлекает из библиотеки соответствующий ему элемент по ключу delaykey Else ' иначе GetDelay = 0 ' нет данных End If 'конец условия End With
Application.ScreenUpdating = True End Function
' макрос (create_payment_report) для переноса данных из отчета по закупкам в отчет по оплате
Public Sub create_payment_report() Dim date_cell As Date Dim Next_date As String Dim weeks_delay As Integer Dim k&, l& Dim row_end, col_end As Integer
With ActiveSheet ' активный лист ' узнать размерность массива row_end = .Cells.Find("*", [A1], xlValues, , xlByRows, xlPrevious).Row 'последняя заполненная строка col_end = .Cells.Find("*", [A1], xlValues, , xlByRows, xlPrevious).Column 'последний заполненный столбец ' переносим данные из закупок в Отчет по оплате MsgBox "Перенос данных в отчет по оплате......" For l = 5 To row_end ' цикл по строкам из таблицы Закупки weeks_delay = .Cells(l, 3).Value ' число недель отсрочки платежа For k = 1 To 12 * 4 ' в таблице Закупки 48 столбцов с датами ActiveWorkbook.Sheets("Отчет по оплате").Cells(l, 4 + k + weeks_delay - 1).Value = ActiveWorkbook.Sheets("Отчет по закупке").Cells(l, 4 + k - 1).Value Next k ' продолжаем цикл по столбцам Next l ' продолжаем цикл по строкам MsgBox "отчет по оплате сформирован" End With End Sub