Есть ли способ перебрать два списка в VBA, копируя один в другой, но никогда не копируя повторяющееся значение?

У меня есть два листа. Лист 1) Список массовых слотов, Лист 2) Типы хранилищ местоположений

Мне нужно просмотреть примерно 15 000 строк на листе 1 и использовать определенный код в столбце AQ (который может быть одним из 39 кодов, например 1A8, 5K2, 2C12 и т. д.), чтобы просмотреть лист 2 на наличие строк с одинаковым кодом. в столбце B. Информация, которая мне нужна, находится в столбце A листа 2 и должна быть перенесена в столбец C листа 1.

Другие требования: столбец C Листа 2 должен = «L», столбец D должен = «Нет», а столбец E должен соответствовать столбцу A Листа 1.

Один и тот же результат из столбца А на листе 2 не может быть использован дважды, его необходимо перейти к следующему результату, соответствующему критериям.

Конечный результат, которого я пытаюсь достичь, заключается в том, что я просматриваю каждую строку листа 1 и заполняю столбец C результатом, отличным от результата столбца A листа 2, который соответствует всем критериям, перечисленным выше.

Редактировать № 4: Переписал вопрос, чтобы он был, надеюсь, более точным.

Set msl = Worksheets("Mass Slot List")
Set lst = Worksheets("Location Storage Types")

aRow = wsl.Range("A50000").End(xlUp).Row
bRow = lst.Range("A120000").End(xlUp).Row

For x = 2 To aRow

    If msl.Range("AQ" & x) = "1A8" Then
        For y = 1 To bRow
            If lst.Range("B" & y) = "1A8" And lst.Range("C" & y) = "L" And lst.Range("D" & y) = "No" And          lst.Range("E" & y) = msl.Range("A" & x) Then
                msl.Range("C" & x) = lst.Range("A" & y)
                
                Exit For
            End If
        Next y
    End If
Next x

Я попробовал приведенный выше код, но он просто проработал несколько минут и принудительно закрыл Excel.

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

Редактировать №1: В комментариях получил конструктивную критику.

Лист 2 выглядит так:

Лист 1 выглядит так:

Изменение № 2: ссылка на уменьшенную и упрощенную версию файла (обновлено x2):

https://fastupload.io/8eee9b2bd4d9a6d3

Редактировать №3:Первый проход решения Тима


88
1

Ответ:

Решено

Скомпилировано, но не протестировано: на основе опубликованного вами кода.

Sub tester()
    
    Dim msl As Worksheet, lst As Worksheet, wb As Workbook
    Dim lrMsl As Long, lrLst As Long, id As String, mslA
    Dim arrMslAQ, arrLstAtoE, x As Long, y As Long
    
    Set wb = ThisWorkbook
    Set msl = wb.Worksheets("Mass Slot List")
    Set lst = wb.Worksheets("Location Storage Types")
    
    lrMsl = msl.Cells(msl.Rows.count, "A").End(xlUp).Row
    lrLst = lst.Range(lst.Rows.count, "A").End(xlUp).Row
    
    'read data into arrays for faster access
    arrMslAQ = msl.Range("AQ1:AQ" & lrMsl) 'col AQ only
    arrLstAtoE = lst.Range("A1:E" & lrLst) 'cols A to E
    
    id = "1A8"
    
    For x = 2 To lrMsl
        mslA = msl.Cells(x, "A").Value 'only need to read this once...
        If arrMslAQ(x, 1) = id Then
            For y = 1 To lrLst
                If arrLstAtoE(y, 2) = id Then
                    If arrLstAtoE(y, 3) = "L" Then
                        If arrLstAtoE(y, 4) = "No" Then
                            If arrLstAtoE(y, 5) = mslA Then
                                'update and exit
                                msl.Cells(x, "C").Value = arrLstAtoE(y, 1)
                                arrLstAtoE(y, 4) = "Yes" 'flag as used
                                Exit For
                            End If
                        End If
                    End If
                End If
            Next y
        End If
    Next x

End Sub

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