Копировать данные с одного листа на другой, если он не существует на основе критериев - PullRequest
0 голосов
/ 08 апреля 2019

В моей книге есть 2 листа, один из которых называется «Данные», а другой - «Отображение определения учетной записи», Рабочий лист данных состоит из 3 столбцов. Код сущности (столбец A), номер счета (столбец B) и определение учетной записи (столбец C) и отображение определения учетной записи состоит из столбца кода сущности и определения учетной записи в 2 наборах (.ie столбец A & B [модель определения учетной записи 1] и D). & E [Модель определения счета 2]), первый набор называется моделью определения счета 1, а второй набор называется моделью определения счета 2.

Теперь я хочу, чтобы мой макрос проверял столбцы A, B и C таблицы данных в комбинации, и если для конкретной учетной записи код сущности и определение учетной записи не существует, скопируйте их из таблицы сопоставления определения учетной записи и вставьте эти строки для этой учетной записи в листе данных. Проблема здесь заключается в том, что у нас нет столбца с номером учетной записи в таблице сопоставления определений учетных записей, поэтому мы не можем просто сравнить оба непосредственно один к одному. Также модель сопоставления определения учетной записи может быть выбрана пользователем, выбрав ее из таблицы данных. Ячейка J2, в соответствии с которой макрос должен либо проверять в столбцах A и B, выбирает ли пользователь модель определения учетной записи 1, но если он выбирает модель определения учетной записи 2, то макрос должен проверять наличие данных в столбцах D и E таблицы сопоставления определения учетной записи.

Ниже приведен полученный мной код, который в идеале проверяется на основе всех полей, сравнивающих один к одному в обеих таблицах, но, как упоминалось ранее, проблема заключается в том, что у нас нет поля номера счета в рабочем листе определения учетной записи, поэтому он сравнивает 3 столбца данных .ie Комбинация кода сущности, номера счета и определения учетной записи из таблицы данных с двумя столбцами. Код сущности и определение учетной записи в сопоставлении определения учетной записи, чтобы увидеть комбинацию кода сущности и определения учетной записи, перечисленную в поле сопоставления определения учетной записи, существует в листе данных для всех учетных записей в листе данных, а если нет, то добавьте его и выделите желтым цветом. Прилагается рабочая тетрадь.

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
...