VBA - если условие выполнено, сначала проверьте значение в диапазоне другого листа.При совпадении вернуть заданное значение, а если нет, добавить данные в новую строку

Question

Я довольно близко подошел к тому, чтобы заставить это работать, но мои знания VBA ограничены, и я не могу определить, где / почему этот код не работает.

В Sheet1 (Destination) есть список CaseИдентификаторы и проблемы в следующем формате:

Case ID      Issue 1        Issue 2      Issue 3
999          contact        email        address
998          contact

На листе 2 (источник данных) содержатся данные в следующем формате:

Case ID      Contact     Email           Address
999          Jim         jim@jim.com     123 Jim Ave
998          (blank)     (blank)         (blank)

ЦЕЛЬ: поскольку некоторые идентификаторы дел уже присутствуют вНа листе 1 цель состоит в том, чтобы макрокоманду сканировали на листе 2 и

• , если идентификатор дела НАЙДЕН, проверьте, не заполнено ли поле «Проблема 2».Если это так, возьмите заголовок столбца и вставьте в ту же строку, где находится идентификатор случая на листе 1.
• , если идентификатор случая НЕ НАЙДЕН, то добавьте идентификатор случая в последнюю строку листа 1, Столбец A, а также добавьте заголовок столбца в столбец Проблема 2. в той же строке.

Цель состоит в том, чтобы выделить проблемы в таблице данных с несколькими условиями и вставить их в лист «Проблемы»,В этом случае с помощью приведенного ниже кода оператор IF выполняет поиск ячеек с Interior.ColorIndex = 2 в листе данных (Sheet2).

ПРОБЛЕМА: мой текущий код не проходит правильно и добавляет CASE ID не найден до последнего ряда листа 1. Кроме того, я не уверен, что мои счетчики настроены правильно.Любая помощь будет оценена.

Sub readCaseIDs()

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Dim lastrow2 As Long
Dim lastrow3 As Long
Dim i As Long
Dim j As Long

Dim wb As Workbook

lastrow = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
lastrow3 = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row



For j = 2 To lastrow3
    For i = 2 To lastrow
        If ThisWorkbook.Sheets("Sheet2").Cells(i, 10).Interior.ColorIndex = 2 Then
            If Sheets("Sheet2").Cells(i, 3) = Sheets("Sheet1").Cells(j, 1) Then 
            Sheets("Sheet1").Cells(j, "D") = Sheets("Sheet2").Cells(1, 10)

            End If
        j = j + 1

            Else
                If ThisWorkbook.Sheets("Sheet2").Cells(i, 10).Interior.ColorIndex = 2 Then
                lastrow2 = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
                Sheets("Sheet2").Cells(i, 3).Copy
                Sheets("Sheet1").Range("A" & lastrow2 + 1).PasteSpecial xlPasteValues
                Sheets("Sheet2").Cells(1, 10).Copy
                Sheets("Sheet1").Range("D" & lastrow2 + 1).PasteSpecial xlPasteValues
                End If
            End If

    Next i
Next j

End Sub

Answer 1

Я бы хотел обменять два ваших For-Next цикла на один цикл с функцией .Find.Вы также можете отказаться от операций Copy-Paste, установив значение напрямую.

Sub readCaseIDs()
    Dim fRng As Range
    Dim i As Long
    Dim lastrow As Long
    Dim pasteRow As Long

    With ThisWorkbook

        lastrow = .Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row

        For i = 2 To lastrow

            If .Sheets("Sheet2").Cells(i, 10).Interior.ColorIndex = 2 Then
                Set fRng = .Sheets("Sheet1").Range("A:A").Find(.Sheets("Sheet2").Cells(i, 3), , xlValues, xlWhole)

                If Not fRng Is Nothing Then
                    If .Sheets("Sheet1").Cells(fRng.Row, "D") = "" Then
                       .Sheets("Sheet1").Cells(fRng.Row, "D") = .Sheets("Sheet2").Cells(1, 10)
                    End If
                Else
                    pasteRow = .Sheets("A" & Rows.Count).End(xlUp).Row + 1
                    .Sheets("Sheet1").Range("A" & pasteRow) = .Sheets("Sheet2").Cells(i, 3)
                    .Sheets("Sheet1").Range("D" & pasteRow) = .Sheets("Sheet2").Cells(1, 10)
                End If
            End If

        Next i

    End With
End Sub