Поиск совпадений между двумя листами и добавление новой строки, если совпадение не найдено - PullRequest
0 голосов
/ 24 января 2019

Для этого сценария у меня есть электронная таблица «База данных» с подсписком, который подает «База данных». В настоящее время у меня есть сценарий VBA, написанный для проверки листа базы данных на соответствие определенной ячейки в каждой строке листа. Если совпадение найдено, эта строка из вложенного листа копируется поверх этой строки на листе базы данных.

То, что я хочу добавить, - это еще одно условие: если не найдено совпадение для строки в подсписке, на которую в данный момент настроен таргетинг, эта строка добавляется в конец листа базы данных.

Я попытался добавить:

ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1LastRow + 1).EntireRow.Value

после цикла поиска, но это не совсем работает, и я не уверен, почему.

Sub Update_Master()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1LastRow As Long, ws2LastRow As Long
Dim ws1Row As Long, ws2Row As Long

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Sheet1")

Set wb2 = Application.Workbooks.Add("C:\Users\MyFolder\Desktop\Excel Master Test\ROLE BASED TRACKER DRAFT.xlsx")
Set ws2 = wb2.Worksheets("Database")

ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row

For ws1Row = 2 To ws1LastRow
    ws1.AutoFilterMode = False
    If ws1.Cells(ws1Row, 4).Value > 0 Then

        For ws2Row = 2 To ws2LastRow
            ws2.AutoFilterMode = False
            If ws2.Cells(ws2Row, 4).Value = ws1.Cells(ws1Row, 4).Value Then
                ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1Row).EntireRow.Value
            End If

        Next ws2Row

    End If

Next ws1Row

ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1LastRow + 1).EntireRow.Value

End Sub

Ответы [ 2 ]

0 голосов
/ 31 января 2019

Для любого, кто сталкивается с этим, я нашел ответ на свой вопрос.Я использовал метод поиска для поиска соответствия.В операторе If я использовал условие «Ничего», чтобы скопировать текущую строку в конец листа.Смотрите решение ниже.

If ws2.Range("D:D").Find(What:=ws1.Cells(ws1Row, 4).Text, _
        LookIn:=xlValues) Is Nothing Then
    ws1.Cells(ws1Row).EntireRow.Value = ws2.Cells(ws2LastRow + 1).Value 
0 голосов
/ 25 января 2019

Итак, у меня есть этот цикл для обновления базы данных информацией из подсписка с использованием метода Find.Отсюда, как я могу скопировать информацию, если совпадение не найдено?Извините ... я новичок в программировании в целом и только что подобрал VBA пару дней назад.

For ws1Row = 2 To ws1LastRow

    Do While ws1.Cells(ws1Row, 4) <> "" 'repeat the following loop until it reaches a blank row

        strSearch = ws1.Cells(ws1Row, 4).Value   'get a hold of the value in column D

        ws1.Rows(ws1Row).EntireRow.Copy 'copy the row to be transferred to the Database

        ws2.Activate

        ws2.Range("D:D").Find(strSearch).Select  'find the row the match is located at on the Database

        r = ActiveCell.Row   'get a hold of current row index

        Range(r & ":" & r).Select

        ActiveCell.PasteSpecial xlPasteAll  'Past the entire row to the Database

        ActiveCell.Offset(1, 0).Select  'go down one row to prepare for next row

        ws1Row = ws1Row + 1

    Loop   'repeat

Next
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...