时间戳

首页 > 解决方案 > 基于多个条件将多行提取到有限模板中

excel - 基于多个条件将多行提取到有限模板中

问题描述

我在从“Datadump”提取到几个连续的“模板”时遇到问题（因为模板只能包含 10 行项目）。

以下是我的意图：

  1. 从数据转储（上面的示例）中，是否可以自动将适当的值提取到模板中，每组模板最多 10 行。然后对已打印到模板的内容进行颜色编码。!-模板] 这些是模板（付款凭证）限制：

    一个。每个模板仅包含1（一）天的数据

如果在 2020 年 1 月 1 日和 2020 年 1 月 2 日，每天有 5 笔交易，则必须有2 个模板（每天 1 个）。

湾。每个模板只能来自1 个来源

因此，如果在 2020 年 1 月 1 日和 2020 年 1 月 2 日，每个来源 A 和 B每天有 5 笔交易，则将有4 个模板（每个来源每天 1 个）。

C。每个模板只能包含10 行。

因此，如果在 2020 年 1 月 1 日和 2020 年 1 月 2 日，每个来源 A 和 B 每天有11笔交易，则将有8 个模板（每个来源/天 2 个）。

我还附上了之前和之后供参考:)

前：

!-之前]

!-模板]

后：

!-之后]

!-优惠券第 1 页]

!-凭证第 2 页]

由于我是 VBA 的新手，因此我对适当位置的输入和颜色代码没有任何问题。但我仍在学习我认为需要的循环功能？

任何帮助将非常感激！

@编辑：

模板的值为：

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

这是我现在可以想出的代码（试图分解过程）

@编辑 @编辑

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 编辑编辑：不幸的是无法使图像出现，因为它需要至少 10 次重复。但是，如果您尝试从图像示例中查看，我认为它会提供很多说明。

标签： exceldatabasevbaextract

解决方案

多条件匹配的一个示例是在多条件匹配/索引 VBA 中跨两个工作表

多条件匹配在行中

If ThisWorkbook.Worksheets("Sheet2").Cells(s, 1).Value = ID And ThisWorkbook.Worksheets("Sheet2").Cells(s, 2).Value = Activity Then
                ThisWorkbook.Worksheets("Sheet2").Cells(s, 3).Value = ThisWorkbook.Worksheets("Sheet1").Cells(r, 3).Value
            End If

其中And连接多个标准，在本例中为 2 个标准。And是逻辑 AND 函数，在 excel 中可用 3 个其他逻辑运算符 OR、XOR 和 NOT（https://www.ablebits.com/office-addins-blog/2014/12/17/excel-and-or-xor- not-functions/ ) 也可以用于多条件匹配。比较和匹配的主要结构是If

在代码中使用了两个嵌套循环，一个循环通过sheet1的第 1 行和第 3 行，另一个循环通过sheet2的第 1 行和第 3 行，在这两个嵌套循环的“核心”中执行比较、匹配。因此，如果您想遍历 2 行两张纸，请使用以下命令：

For r = 2 To ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count

          ... 

        For s = 2 To ThisWorkbook.Worksheets("Sheet2").UsedRange.Rows.Count

           ...

        Next s
    Next r

推荐阅读