Используя 2 листа, если значение ячейки совпадает, введите значение Date из другого столбца

Question

Зная о параметре VLOOKUP, но предпочел бы понять исправления, приведенные ниже, чтобы использовать LOOP

У меня есть данные на 2 листах, и я использую «рабочий файл»запустить макрос.

wbTP - набор данных назначения и базы.

wbEVAL - это место, откуда будет выполняться чтение макроса.

Оба листа имеют идентификатор оценщика, который служит связующим звеном между двумя листами.

ЦЕЛЬ : Считать идентификатор оценщика, начиная со строки 2, в wbTP и проверить каждую строку столбца идентификатора оценщика в wbEVAL .Если найдено, вернуть поле Complete_Date, найденное в другом столбце той же строки.Если не найдено, ничего не делать.Если найдено и поле пустое, ничего не делайте.

Мой код ниже неисправностей в строке OFFSET, которая пытается вернуть значение.Я все еще относительно новичок в VBA, поэтому я считаю, что мои счетчики используются неправильно.Любая помощь будет оценена.

ПРИМЕР УСТАНОВКИ ДАННЫХ:

wbTP :

CASE ID     CREATE DATE     EVALUATOR ID    COMPLETE DATE
10001       1/2/2019        999             (to be pulled in from wbEVAL) 
10002       1/3/2019        998             (to be pulled in from wbEVAL)
10003       2/1/2019        922             (to be pulled in from wbEVAL)

wbEVAL

CASE NAME   CASE TYPE     EVALUATOR ID   COMPLETE DATE
ABC         ENG            999            2/2/2019
BZG         ENG            998            2/3/2019
BBC         PNG            922            3/1/2019

КОД:

    Sub CompleteDate()


    Dim wbTP As Workbook
    Dim wbEVAL As Workbook

    Dim wsTP As Worksheet
    Dim wsEVAL As Worksheet

    Dim iTP As Long
    Dim iEVAL As Long
    Dim iMACRO As Long


    Set wbTP = Workbooks("TP.csv")
    Set wbEVAL = Workbooks("EvalTable.csv")

    Set wsTP = wbTP.Worksheets.Item("TP")
    Set wsEVAL = wbEVAL.Worksheets.Item("EvalTable")

    lastrowTP = wbTP.Sheets("TP").Range("c" & Rows.Count).End(xlUp).Row
    lastroweval = wbEVAL.Sheets("EvalTable").Range("A" & Rows.Count).End(xlUp).Row

    iMACRO = 1


    For iTP = 2 To lastrowTP
        For iEVAL = 2 To lastroweval
            If wsTP.Cells(iTP, 15) = wsEVAL.Cells(iEVAL, 5) Then

                wsTP.Range("BB").Offset(iTP, 0) = wsEVAL.Cells(iEVAL, "E")

                iMACRO = iMACRO + 1

            End If
        Next iEVAL
    Next iTP

End Sub

Answer 1

Почему бы вам просто не использовать формулу VLOOKUP?Вам не нужен VBA, чтобы сделать это.Вы также можете просто написать эту формулу VLOOKUP с вашим рабочим VBA-файлом, если вам нужна какая-то автоматизация.Должно быть легче и намного быстрее, чем 2 циклаавтоматизировано):

Worksheet("TP").Range("D2:D100").Formula = "=IFNA(VLOOKUP(C:C,EvalTable!C:D,2,FALSE),"""")"

и настройте свой диапазон D2:D100.Таким образом, вы получите что-то вроде

Option Explicit

Public Sub CompleteDate()
    Dim wsTP As Worksheet
    Set wsTP = ThisWorkbook.Worksheets("TP")

    Dim wsEVAL As Worksheet
    Set wsEVAL = ThisWorkbook.Worksheets("EvalTable")

    Dim LastRowTP As Long
    LastRowTP = wsTP.Cells(wsTP.Rows.Count, "C").End(xlUp).Row

    wsTP.Range("D2:D" & LastRowTP).Formula = "=IFNA(VLOOKUP(C:C," & wsEVAL.Name & "!C:D,2,FALSE),"""")"
End Sub

---

Это будет сделано с помощью кода с использованием 2 циклов.Но при большем количестве данных это будет ужасно медленно.Перейти с формулой VLOOKUP.Формулы - это сила Excel.

Option Explicit

Public Sub CompleteDate()
    Dim wsTP As Worksheet
    Set wsTP = ThisWorkbook.Worksheets("TP")

    Dim wsEVAL As Worksheet
    Set wsEVAL = ThisWorkbook.Worksheets("EvalTable")

    Dim LastRowTP As Long
    LastRowTP = wsTP.Cells(wsTP.Rows.Count, "C").End(xlUp).Row

    Dim LastRowEval As Long
    LastRowEval = wsEVAL.Cells(wsEVAL.Rows.Count, "A").End(xlUp).Row

    Dim iTP As Long
    Dim iEVAL As Long

    For iTP = 2 To LastRowTP
        For iEVAL = 2 To LastRowEval
            If wsTP.Cells(iTP, "C") = wsEVAL.Cells(iEVAL, "C") Then
                wsTP.Cells(iTP, "D").Value = wsEVAL.Cells(iEVAL, "D").Value
                Exit For
            End If
        Next iEVAL
    Next iTP
End Sub

Answer 2

Диапазоны, Массивы, Коллекция, Словарь

• Вы должны избегать петель всякий раз, когда это возможно.
• На 10000 несортированных уникальных записей в EvalTable и 65000 записей в TP, версия Dictionary закончилась за 1 секунду, версия Collection закончилась чуть позже, VLOOKUP закончилась за 20 секунд и для версии петли диапазона я потерял терпение в 5 минут и прервал Это. Можно рассмотреть цикл с использованием версии массивов и, возможно, версию Index/Match.
• Первый код демонстрирует, как использовать Key в Collection.
• С некоторыми изменениями тот же код преобразуется в Dictionary версию (см. ниже), что даже немного быстрее, чем версия Collection, вероятно, из-за того, что нет необходимости в преобразовании строк (CStr).

Коллекционная версия

Sub CompleteDate()
    ' Source
    Const cWbS As String = "EvalTable"    ' Workbook Name
    Const cWsS As Variant = "EvalTable"   ' Worksheet Name/Index
    Const cEvS As Variant = "C"           ' Evaluator ID Column Letter/Number
    Const cCdS As Variant = "D"           ' Complete Date Column Letter/Number
    Const cFrS As Long = 2                ' First Row Number
    ' Target
    Const cWbT As String = "TP"   ' Workbook Name
    Const cWsT As Variant = "TP"  ' Worksheet Name/Index
    Const cEvT As Variant = "C"   ' Evaluator ID Column Letter/Number
    Const cCdT As Variant = "D"   ' Complete Date Column Letter/Number
    Const cFrT As Long = 2        ' First Row Number

    Dim Coll As Collection  ' Source Collection
    Dim vntEvS As Variant   ' Source Evaluator ID Array
    Dim vntCdS As Variant   ' Source Complete Date Array
    Dim vntEvT As Variant   ' Target Evaluator ID Array
    Dim vntCdT As Variant   ' Target Complete Date Array

    Dim LurS As Long        ' Source Last Used Row Number
    Dim LurT As Long        ' Target Last Used Row Number
    Dim NorS As Long        ' Source Number of Rows
    Dim NorT As Long        ' Target Number of Rows
    Dim i As Long           ' Source/Target Arrays Row (Element) Counter

    ' In Source Worksheet
    With Workbooks(cWbS).Worksheets(cWsS)
        ' Calculate Last Used Row Number in Evaluator ID Column.
        LurS = .Cells(.Rows.Count, cEvS).End(xlUp).Row
        ' Calculate Evaluator ID Column Range.
        ' Copy Evaluator ID Column Range to Evaluator ID Array.
        vntEvS = .Cells(cFrS, cEvS).Resize(LurS - cFrS + 1)
        ' Copy Complete Date Column Range to Complete Date Array.
        vntCdS = .Cells(cFrS, cCdS).Resize(LurS - cFrS + 1)
    End With

    ' Write number of rows (elements) of Evaluator ID Array to Source
    ' Number of Rows.
    NorS = UBound(vntEvS)
    ' Create a reference to a new collection (Source Collection).
    Set Coll = New Collection
    ' Loop through rows (elements) of Source Arrays (Source Collection).
    For i = 1 To NorS
        ' Write current value of Complete Date Array as current item, and
        ' current value of Evaluator ID Array, converted to string, as current
        ' key to Source Collection.
        Coll.Add vntCdS(i, 1), CStr(vntEvS(i, 1))
    Next

    ' In Target Worksheet
    With Workbooks(cWbT).Worksheets(cWsT)
        ' Calculate Last Used Row Number in Evaluator ID Column.
        LurT = .Cells(.Rows.Count, cEvT).End(xlUp).Row
        ' Calculate Evaluator ID Column Range.
        ' Copy Evaluator ID Column Range to Evaluator ID Array.
        vntEvT = .Cells(cFrT, cEvT).Resize(LurT - cFrT + 1)
    End With

    ' Write number of rows (elements) of Evaluator ID Array to Target
    ' Number of Rows.
    NorT = UBound(vntEvT)
    ' Resize Target Complete Date Array to size of Target Evaluator ID Array.
    ReDim vntCdT(1 To NorT, 1 To 1)
    ' Loop through rows (elements) of Target Arrays.
    For i = 1 To NorT
        ' Use current value of Target Evaluator ID Array, converted to string,
        ' as key to retrieve item from Source Collection to write to current
        ' row (element) of Target Complete Date Array.
        vntCdT(i, 1) = Coll(CStr(vntEvT(i, 1)))
    Next

    ' In Target Worksheet
    With Workbooks(cWbT).Worksheets(cWsT)
        ' Calculate Target Column Range.
        ' Copy Target Complete Date Array to Target Complete Date Column Range.
        .Cells(cFrT, cCdT).Resize(NorT) = vntCdT
    End With

End Sub

Словарь версии

Sub CompleteDateDict()
    ' Source
    Const cWbS As String = "EvalTable"    ' Workbook Name
    Const cWsS As Variant = "EvalTable"   ' Worksheet Name/Index
    Const cEvS As Variant = "C"           ' Evaluator ID Column Letter/Number
    Const cCdS As Variant = "D"           ' Complete Date Column Letter/Number
    Const cFrS As Long = 2                ' First Row Number
    ' Target
    Const cWbT As String = "TP"   ' Workbook Name
    Const cWsT As Variant = "TP"  ' Worksheet Name/Index
    Const cEvT As Variant = "C"   ' Evaluator ID Column Letter/Number
    Const cCdT As Variant = "D"   ' Complete Date Column Letter/Number
    Const cFrT As Long = 2        ' First Row Number

    Dim dict As Object      ' Source Dictionary
    Dim vntEvS As Variant   ' Source Evaluator ID Array
    Dim vntCdS As Variant   ' Source Complete Date Array
    Dim vntEvT As Variant   ' Target Evaluator ID Array
    Dim vntCdT As Variant   ' Target Complete Date Array

    Dim LurS As Long        ' Source Last Used Row Number
    Dim LurT As Long        ' Target Last Used Row Number
    Dim NorS As Long        ' Source Number of Rows
    Dim NorT As Long        ' Target Number of Rows
    Dim i As Long           ' Source/Target Arrays Row (Element) Counter

    ' In Source Worksheet
    With Workbooks(cWbS).Worksheets(cWsS)
        ' Calculate Last Used Row Number in Evaluator ID Column.
        LurS = .Cells(.Rows.Count, cEvS).End(xlUp).Row
        ' Calculate Evaluator ID Column Range.
        ' Copy Evaluator ID Column Range to Evaluator ID Array.
        vntEvS = .Cells(cFrS, cEvS).Resize(LurS - cFrS + 1)
        ' Copy Complete Date Column Range to Complete Date Array.
        vntCdS = .Cells(cFrS, cCdS).Resize(LurS - cFrS + 1)
    End With

    ' Write number of rows (elements) of Evaluator ID Array to Source
    ' Number of Rows.
    NorS = UBound(vntEvS)
    ' Create a reference to a new collection (Source Collection).
    Set dict = CreateObject("Scripting.Dictionary")
    ' Loop through rows (elements) of Source Arrays (Source Collection).
    For i = 1 To NorS
        ' Write current value of Complete Date Array as current value, and
        ' current value of Evaluator ID Array as current key
        ' to Source Dictionary.
        dict.Add vntEvS(i, 1), vntCdS(i, 1)
    Next

    ' In Target Worksheet
    With Workbooks(cWbT).Worksheets(cWsT)
        ' Calculate Last Used Row Number in Evaluator ID Column.
        LurT = .Cells(.Rows.Count, cEvT).End(xlUp).Row
        ' Calculate Evaluator ID Column Range.
        ' Copy Evaluator ID Column Range to Evaluator ID Array.
        vntEvT = .Cells(cFrT, cEvT).Resize(LurT - cFrT + 1)
    End With

    ' Write number of rows (elements) of Evaluator ID Array to Target
    ' Number of Rows.
    NorT = UBound(vntEvT)
    ' Resize Target Complete Date Array to size of Target Evaluator ID Array.
    ReDim vntCdT(1 To NorT, 1 To 1)
    ' Loop through rows (elements) of Target Arrays.
    For i = 1 To NorT
        ' Use current value of Target Evaluator ID Array as key to retrieve
        ' value from Source Dictionary to write to current row (element)
        ' of Target Complete Date Array.
        vntCdT(i, 1) = dict(vntEvT(i, 1))
    Next

    ' In Target Worksheet
    With Workbooks(cWbT).Worksheets(cWsT)
        ' Calculate Target Column Range.
        ' Copy Target Complete Date Array to Target Complete Date Column Range.
        .Cells(cFrT, cCdT).Resize(NorT) = vntCdT
    End With

End Sub

Answer 3

Попробуйте следующую формулу:

=IFNA(VLOOKUP(C2,wbEVAL!$C$2:$D$4,2,FALSE),"")

wbTP:

wbEval: