如果某个条件不存在,则将数据从一个工作表复制到另一个工作表

时间:2019-04-08 02:51:27

标签: excel copy worksheet

我的工作簿中有2个工作表,一个工作表名为“数据”,另一个工作表名为“帐户定义映射”,数据工作表由3列组成。实体代码(A列),帐号(B列)和账户定义(C列)和账户定义映射包括2组中的实体代码和账户定义列(即A和B列[账户定义模型1]和D &E [Account Definition Model 2]),第一组称为“帐户定义模型1”,第二组称为“帐户定义模型2”。

现在,我希望我的宏结合检查“数据工作表”列A,B和C,如果特定帐户的实体代码和帐户定义不存在,则从“帐户定义”映射工作表中复制相同的代码并插入那些行数据工作表中的该帐户。这里的问题是,我们在“帐户定义映射”工作表中没有“帐号”列,因此我们不能简单地将两者直接进行一对一比较,而且用户可以通过从“数据表”中选择相同的帐户来定义映射模型单元格J2,如果用户选择“帐户定义模型1”,则应根据哪个宏从A和B列中进行检查,但是如果他选择“帐户定义模型2”,则宏应检查“帐户定义映射”工作表的D和E列中是否存在数据。 / p>

下面是我得到的代码,该代码理想地根据两个工作表之间的一对一比较的所有字段进行检查,但是如前所述,问题是我们在“帐户定义工作表”中没有帐号字段,因此它正在进行比较3列数据.ie数据工作表中的实体代码,帐号和帐户定义组合,分别位于2列。数据工作表中所有帐户的数据工作表中都存在“帐户定义”映射中的实体代码和帐户定义,以查看“帐户定义”映射字段中列出的实体代码和帐户定义组合,如果没有,则添加该实体代码和帐户定义并以黄色突出显示。附件是工作簿。

Option Explicit

    Sub CopymissingData()

    Dim k, kk(), i As Long, c As Long
    Dim n As Long, q, s As String

    q = Array(4, 5, 8, 9)
    k = Sheets("Data").Range("a1").CurrentRegion.Value2
    ReDim kk(1 To UBound(k, 1), 1 To UBound(k, 2))

    With CreateObject("scripting.dictionary")
    .comparemode = 1
    For i = 2 To UBound(k, 1)
    s = vbNullString
    For c = 0 To UBound(q): s = s & "|" & k(i, q(c)): Next
    .Item(s) = Empty
    Next
    k = Sheets("Account Definition Mapping").Range("a1").CurrentRegion.Value2
    For i = 2 To UBound(k, 1)
    s = vbNullString
    For c = 0 To UBound(q): s = s & "|" & k(i, q(c)): Next
    If Not .exists(s) Then
    n = n + 1
    For c = 1 To UBound(k, 2): kk(n, c) = k(i, c): Next
    End If
    Next
    End With

    If n Then
        With Sheet1

            With .Range("a" & .Rows.Count).End(xlUp)(2).Resize(n, UBound(kk, 2))
                .Value = kk
                .Interior.Color = vbYellow
            End With
        End With
    End If

    End Sub

0 个答案:

没有答案