VBA: если значение найдено в справочном листе, тогда перетащите данные + поля из исходного листа в лист назначения

Question

У меня есть данные в 2 листах; справочный лист со списком идентификаторов дел и исходный лист с идентификаторами дел, именами клиентов, номерами, описаниями и т. д.

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

Public Sub MainFileData2()

Dim i As Long, k As Long

Dim wbmacro As Workbook
Dim wbmain As Workbook

Set wbmacro = Workbooks.Item("MacroFile.xlsm")
Set wbmain = Workbooks.Item("SourceFile.csv")

Dim wsmacro As Worksheet
Dim wsmain As Worksheet
Dim wsref As Worksheet

Set wsmacro = wbmacro.Worksheets.Item("Data")
Set wsmain = wbmain.Worksheets.Item("SourceFileData")
Set wsref = wbmacro.Worksheets.Item("Sheet1")
Set destsht = Workbooks("MacroFile.xlsm").Worksheets("Data")

Dim engrange As Range
Set engrange = wsmain.Range("B2:B500000")

Dim cell As Range

k = 1
i = 2
DestLastRow = destsht.Cells(destsht.Rows.Count, 1).End(xlUp).Row


Application.ScreenUpdating = False

For Each cell In engrange

    If engrange.Cells(i, 1) = wsref.Cells(k, 1) Then

        wsmacro.Range("candnum").Offset(i, 0) = wsmain.Range("b2").Offset(i, 0)
        wsmacro.Range("candname").Offset(i, 0) = wsmain.Range("c2").Offset(i, 0)
        wsmacro.Range("estat").Offset(i, 0) = wsmain.Range("e2").Offset(i, 0)
        wsmacro.Range("ira").Offset(i, 0) = wsmain.Range("g2").Offset(i, 0)
        wsmacro.Range("wrkflw").Offset(i, 0) = wsmain.Range("k2").Offset(i, 0)
        wsmacro.Range("fln").Offset(i, 0) = wsmain.Range("o2").Offset(i, 0)
        wsmacro.Range("city").Offset(i, 0) = wsmain.Range("r2").Offset(i, 0)
        wsmacro.Range("country").Offset(i, 0) = wsmain.Range("s2").Offset(i, 0)

        i = i + 1

        Else: i = i + 1


    End If

Next cell

Application.ScreenUpdating = True


End Sub

Когда код циклически переходит на i, он находит значение в строке 20 в исходном файле, например, и в итоге вставляет значения полностью в строку 20 в файле назначения (лист «Данные»), пропуская первые 19 пустых строк. Я попытался использовать destlastrow вместо i , и это закончилось перезаписью значения и тоже не работало корректно.

Любые идеи / предложения будут оценены. Заранее спасибо.

Answer 1

Несколько вещей, которые могут помочь

1. Я бы рекомендовал изменить engrange на Long тип данных и Set engrange = wsmain.Range("B2:B500000") на engrange = wsmain.Range("B" & Rows.Count).End(xlUp).Row, чтобы вы могли использовать For Loop, и вам не нужно вручную увеличивать i на каждой итерации.
2. Я бы попытался использовать выходной диапазон, который смещается на каждой итерации, где ваш оператор If оценивается как True. Сейчас он просто берет значение i и помещает его туда, потому что вы увеличиваете его на каждой итерации.
3. Похоже, вы пытаетесь сопоставить значение. Вместо того, чтобы перебирать весь лист для каждого значения, ищущего совпадение, почему бы не использовать .Find?

Я бы написал так:

Public Sub MainFileData2()

Dim i As Long, k As Long

Dim wbmacro As Workbook
Dim wbmain As Workbook

Set wbmacro = Workbooks.Item("MacroFile.xlsm")
Set wbmain = Workbooks.Item("SourceFile.csv")

Dim wsmacro As Worksheet
Dim wsmain As Worksheet
Dim wsref As Worksheet

Set wsmacro = wbmacro.Worksheets.Item("Data")
Set wsmain = wbmain.Worksheets.Item("SourceFileData")
Set wsref = wbmacro.Worksheets.Item("Sheet1")
Set destsht = Workbooks("MacroFile.xlsm").Worksheets("Data")

Dim engrange As Long
engrange = wsmain.Range("B" & Rows.Count).End(xlUp).Row

Dim fRng as Range

Dim outRng as Range
Set outRng = wsmacro.Range("A2")    

Application.ScreenUpdating = False

For i = 2 to engrange

    Set fRng = wsref.Range("A:A").Find(wsmain.Cells(i, 2),,xlValues,xlWhole)

    If not fRng Is Nothing Then

        outRng.Offset(0, 0) = wsmain.Range("B" & i)
        outRng.Offset(0, 1) = wsmain.Range("C" & i)
        outRng.Offset(0, 2) = wsmain.Range("E" & i)
        outRng.Offset(0, 3) = wsmain.Range("G" & i)
        outRng.Offset(0, 4) = wsmain.Range("K" & i)
        outRng.Offset(0, 5) = wsmain.Range("O" & i)
        outRng.Offset(0, 6) = wsmain.Range("R" & i)
        outRng.Offset(0, 7) = wsmain.Range("S" & i)

        Set outRng = outRng.Offset(1, 0)

    End If

Next i

Application.ScreenUpdating = True


End Sub

Функция поиска будет выполнять намного быстрее, чем поиск совпадений в каждой ячейке, а использование метода Range("B" & Rows.Count).End(xlUp).Row гарантирует, что вы никогда не будете искать пустые строки.

Answer 2

С вашим кодом довольно мало серьезных проблем. Не пытаясь быть резким, но, надеюсь, это поможет вам понять изменения, которые я предлагаю.

У вас есть две переменные для использования в качестве индексов (i, k), но вы только увеличиваете i. k остается неизменным все время. Вот почему вы получаете вывод только в 1 строку.

Вы также использовали цикл For Each, который по существу добавляет еще один набор невидимых индексов для того же набора данных, который вы используете в i. Вам лучше использовать For цикл с i, который избавит от необходимости i=i+1, и создать enrange.

Кроме того, в разделе оператора IF вашего кода вы используете i по обе стороны от знака =, поэтому вы выводите результат 1 на wsmacro в той же строке что он найден на wsmain.

Использование DestLastRow вместо i для выходной строки на wsmacro также создаст вам проблемы, потому что он рассчитывается только один раз (у вас его нет внутри цикла), поэтому данные перезаписываются.

У вас есть 3 разных листа, по которым вы путешествуете, поэтому вам нужно 3 разных индекса.

Кроме того, wsmacro и destsht относятся к одной и той же таблице. Вам не нужны оба.

С учетом всего сказанного, вот мое непроверенное предложение:

Public Sub MainFileData2()

Dim iDest As Long, iMain As Long, iRef As Long
Dim MainLastRow As Long, RefLastRow As Long

Dim wbMacro As Workbook
Dim wbMain As Workbook

Set wbMacro = Workbooks.Item("MacroFile.xlsm")
Set wbMain = Workbooks.Item("SourceFile.csv")

Dim wsMacro As Worksheet
Dim wsMain As Worksheet
Dim wsRef As Worksheet

Set wsMain = wbMain.Worksheets.Item("SourceFileData")
Set wsRef = wbMacro.Worksheets.Item("Sheet1")
Set wsMacro = wbMacro.Worksheets("Data")

iMacro = 1   'Index for the destination sheet

MainLastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row
RefLastRow = wsRef.Cells(wsRef.Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False


For iMain = 2 To MainLastRow    'Go through each row of wsMain
    For iRef = 2 To RefLastRow  'For each row in the Main sheet, go through each row of the reference sheet
        If wsMain.Cells(iMain, 1) = wsRef.Cells(iRef, 1) Then

            wsMacro.Range("candnum").Offset(iMacro, 0) = wsMain.Cells(iMain, "B")
            wsMacro.Range("candname").Offset(iMacro, 0) = wsMain.Cells(iMain, "C")
            wsMacro.Range("estat").Offset(iMacro, 0) = wsMain.Cells(iMain, "E")
            wsMacro.Range("ira").Offset(iMacro, 0) = wsMain.Cells(iMain, "G")
            wsMacro.Range("wrkflw").Offset(iMacro, 0) = wsMain.Cells(iMain, "K")
            wsMacro.Range("fln").Offset(iMacro, 0) = wsMain.Cells(iMain, "O")
            wsMacro.Range("city").Offset(iMacro, 0) = wsMain.Cells(iMain, "R")
            wsMacro.Range("country").Offset(iMacro, 0) = wsMain.Cells(iMain, "S")

            iMacro = iMacro + 1 'Ensures the next output to wsMacro will go in the next row

            Exit For 'The match has been found, so you can move on to the next row in wsMain without checking the rest of the rows in wsRef
        End If
    Next iRef
Next iMain

Application.ScreenUpdating = True

End Sub

Answer 3

Ваш код действительно должен быть структурирован примерно так - используйте i только в качестве счетчика строки назначения, увеличивая его только тогда, когда вы добавили строку. Ваш For each cell in engrange будет проходить через каждую ячейку в Range("B2:B500000") - не пытайтесь снова использовать engrange в вашем цикле, когда вы уже определили его как диапазон, через который вы перебираете.

Хотя я могу сделать здесь только так, потому что я понятия не имею, к чему относятся эти именованные диапазоны - ИМО, я бы полностью избавился от названных диапазонов.

Option Explicit
Public Sub MainFileData2()

Dim i As Long, k As Long

Dim wbmacro As Workbook
Dim wbmain As Workbook

Set wbmacro = Workbooks.Item("MacroFile.xlsm")
Set wbmain = Workbooks.Item("SourceFile.csv")

Dim wsmacro As Worksheet
Dim wsmain As Worksheet
Dim wsref As Worksheet

Set wsmacro = wbmacro.Worksheets.Item("Data")
Set wsmain = wbmain.Worksheets.Item("SourceFileData")
Set wsref = wbmacro.Worksheets.Item("Sheet1")

Dim engrange As Range
Set engrange = wsmain.Range("B2:B500000")

Dim cell As Range

k = 1
i = 2

Application.ScreenUpdating = False

For Each cell In engrange

    If cell.Value = wsref.Cells(k, 1).Value Then

        wsmacro.Cells(i, 1).Value = cell.Offset(, 1).Value
        wsmacro.Cells(i, 2).Value = cell.Offset(, 2).Value
        wsmacro.Cells(i, 3).Value = cell.Offset(, 3).Value
        wsmacro.Cells(i, 4).Value = cell.Offset(, 4).Value
        wsmacro.Cells(i, 5).Value = cell.Offset(, 5).Value
        wsmacro.Cells(i, 6).Value = cell.Offset(, 6).Value
        wsmacro.Cells(i, 7).Value = cell.Offset(, 7).Value
        wsmacro.Cells(i, 8).Value = cell.Offset(, 8).Value

        i = i + 1

    End If

Next cell

Application.ScreenUpdating = True

End Sub