У меня проблема с извлечением из «Datadump» в несколько непрерывных «Template» (так как шаблон может содержать только 10 строк элемента).
Вот мои намерения:
Из дампа данных (пример выше) можно автоматически извлечь соответствующее значение в шаблон с максимум 10 строками для каждого набора шаблона. А затем цветовой код те, которые были напечатаны в шаблон. ! - Шаблон ] Это ограничения шаблона (платежного ваучера):
a. Каждый шаблон содержит данные только за 1 (один) день
Если в 1 января 2020 года и 2 января 2020 года есть 5 транзакций / день , должно быть 2 шаблона (по 1 на каждый день).
b. Каждый шаблон должен быть только из 1 источника
Так что, если в 1 января 2020 года и 2 января 2020 года, есть 5 транзакций в день с каждого источника A & B , будет 4 шаблона (по 1 на каждый источник / день) .
c. Каждый шаблон может содержать только 10 строк.
Таким образом, если в 1 января 2020 года и 2 января 2020 года, будет 11 транзакций / день от каждого источника A & B, было бы 8 шаблонов (по 2 на каждый источник / день) .
Я также прикрепил до и после для справки:)
До:
! - До ]
! - Шаблон ]
После:
! - После ]
! - Ваучер Page 1 ]
! - Ваучер Page 2 ]
Поскольку я новичок в VBA, у меня не будет проблем с вводом данных в соответствующие места и с цветовым кодом. Но я все еще изучаю функцию l oop, которая, по моему мнению, понадобится для этого?
Любая помощь будет принята с благодарностью!
@ Edit:
Значения для шаблонов:
1. Credit Source = Source + Source Name
2. Total = All values inside the voucher
3. Account = Item Code
4. Detail = Item Name
5. Unit Code = Unit Code
6. Value = Total Debit
Вот коды, с которыми я мог бы сейчас придумать (Пытаюсь сломать процесс)
@ edit @ edit
Sub learn()
Set wb = ThisWorkbook
Set dtws = Worksheets("Database")
Set wstr = Worksheets("trial")
Dim vcdate
vcdate = wstr.Cells(2, "B").Value
Dim vcsource
vcsource = wstr.Cells(2, "D").Value
Dim NoE As Long
Dim lmtcount As Long
'Limiting No. Of Entries
'With wstr
' .Cells(2, 1).Value = Application.WorksheetFunction.CountIfs(dtws.Range("A:A"), vcdate, dtws.Range("J:J"), vcsource)
' NoE = wstr.Cells(2, 1).Value
'If NoE < 11 Then
' .Cells(2, 3).Value = NoE
'Else
' .Cells(2, 3).Value = 10
'End If
'End With
'lmtcount = wstr.Cells(2, 3).Value
'MsgBox NoE
'End of Limiting No. Of Entries
'------------------------
'Inputting Appropriately
'------------------------
Set tempws = Worksheets("Template")
Dim lrow As Long
Dim Count1 As Long
For Count1 = 1 To 100
lrow = tempws.Range("A" & Rows.Count).End(xlUp).Row
'MsgBox lrow
If lrow = 19 Then Exit For
'-----------------------------------------
'MsgBox dtws.Cells(Count1 + 1, "A").Value
'-----------------------------------------
'Cross-Check if the same date
If CDate(dtws.Cells(Count1 + 1, "A").Value) > CDate(vcdate) Then Exit For
'-----------------------------------------
'Cross check error
'MsgBox dtws.Cells(Count1 + 1, "A").Value
'MsgBox dtws.Cells(Count1 + 1, "J").Value
'-----------------------------------------
If dtws.Cells(Count1 + 1, "J").Value2 = vcsource Then
With tempws
.Cells(lrow + 1, "A") = dtws.Cells(Count1 + 1, 2)
.Cells(lrow + 1, "C") = dtws.Cells(Count1 + 1, 3) & " - " & dtws.Cells(Count1 + 1, 5)
.Cells(lrow + 1, "G") = dtws.Cells(Count1 + 1, 6)
.Cells(lrow + 1, "I") = dtws.Cells(Count1 + 1, 9)
End With
'-----------------------------------------
'Colour Code
'-----------------------------------------
With dtws
.Cells(Count1 + 1, 2).Interior.Color = 13998939
.Cells(Count1 + 1, 3).Interior.Color = 13998939
.Cells(Count1 + 1, 6).Interior.Color = 13998939
.Cells(Count1 + 1, 9).Interior.Color = 13998939
End With
End If
Next Count1
With tempws
.Cells(20, "I").Formula = "=sum(I10:I19)"
.Cells(7, "C").Value = tempws.Cells(20, "I").Value
.Cells(4, "J").Value = vcdate
.Cells(6, "C").Value = vcsource
End With
'----------------------------------------
'Input Tracking Order
'----------------------------------------
lrowtr = wstr.Range("A" & Rows.Count).End(xlUp).Row
With wstr
.Cells(lrowtr + 1, "A").Value = vcsource
.Cells(lrowtr + 1, "B").Value = vcdate
.Cells(lrowtr + 1, "C").Value = Count1
End With
'----------------------------------------
'End of Input Tracking order
'----------------------------------------
End Sub
Полагаю, у меня не возникло бы проблемы с цветовым кодированием, но похоже, что извлечение данных является основной проблемой ...
Любая помощь будет принята!
@ edit edit редактировать: К сожалению, не удалось сделать изображение отображаемым, так как для этого требуется не менее 10 повторений. Но если вы попытаетесь увидеть на примере изображения, я думаю, что это даст много разъяснений.