Есть ли способ перебрать два списка в 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:Первый проход решения Тима
У вас есть 4 If теста в одной строке — ваш код будет работать быстрее, если вы вложите каждый из них как отдельные тесты. В нынешнем виде, даже если первый тест завершится неудачно, остальные три все равно будут выполняться, что означает 3 дополнительных чтения ячеек за итерацию.
... и вы увидите гораздо лучшую производительность, если сначала прочитаете данные в массивы и будете циклически перебирать эти массивы вместо чтения ячеек за ячейками из листов.
Последний комментарий! В вашем вопросе было бы очень полезно показать некоторые примеры данных - только соответствующие столбцы. Также вы могли бы немного подробнее объяснить, что вы подразумеваете под «у меня нет возможности не создавать дубликаты» - что именно является дубликатом в данном случае?
Пожалуйста, включите достаточно образца данных в виде текста, который можно скопировать/вставить, и ожидаемые результаты из этого образца данных. На самом деле мы можем делать только общие заявления, такие как рекомендации @TimWilliams по ускорению процесса, но не более того.
@TimWilliams Под сбоем Excel я подразумеваю то, что Excel перестает отвечать на запросы, и мне приходится закрыть программу. Мне удалось найти один ответ, используя мои критерии, после того, как я снова открыл программу, так что я думаю, что я на правильном пути. Мне просто нужен более эффективный способ сделать это. Кроме того, я отредактировал сообщение и добавил некоторые данные, чтобы, надеюсь, дать вам лучшее представление о том, что я пытаюсь сделать.
@RonRosenfeld Привет, Рон, я добавил небольшой образец файла в конец сообщения, чтобы, надеюсь, прояснить проблему. Подскажите, что еще может помочь.
@Hobis Ваша ссылка не работает. И на ваших скриншотах не показаны исходные данные и результаты.
@RonRosenfeld Я изменил ссылку, но оригинальных результатов не было. Моя попытка закончилась полным провалом.
@Хобис, я сдаюсь. Ваша текущая загрузка мне не подходит. Что-то в моей учетной записи не разрешено открывать эту книгу. Надеюсь, кто-то другой сможет вам помочь.
К вашему размещенному файлу применено какое-то управление правами на информацию, поэтому, скорее всего, никто не сможет (или не захочет) открыть его.
@TimWilliams Вы на 100% правы, я совершенно забыл удалить это перед загрузкой. Обновлена новая ссылка на файл без DRM.
@RonRosenfeld Прошу прощения, Рон, как отмечал ранее Тим, там было DRM. Я забыл его удалить. Удалил DRM, загрузил файл и отредактировал по новой ссылке.
Ответы 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
Есть и другие более быстрые способы решения этой проблемы, но этот наиболее близок к тому, что у вас уже есть.
Я очень ценю это. Я запустил код, и он работал очень быстро и назначил местоположение каждой детали типа 1A8, но одно и то же местоположение было назначено каждой детали этого типа. Единственным исключением был момент, когда он достиг строки 11975, когда он изменился на другое местоположение и начал назначать это же местоположение остальным местоположениям. В итоге у меня получилось две разные локации, в каждой из которых было назначено несколько тысяч предметов. Пытаюсь добавить картинку для справки.
Всегда будет назначено первое местоположение, соответствующее критериям. Из вашего поста неясно, что должно произойти вместо этого. Существует ли какое-то максимальное количество раз, когда одно и то же место можно использовать? Только один раз?
Мои извинения, Тим, да, каждой локации может быть назначена только одна часть. Я добавил изображение результатов вашего ответа внизу поста. Есть ли способ сделать «id» переменной для списка различных кодов? Пример: «1А8, 5К2» и т. д.? Обещаю, я не пытаюсь усложнять, я просто невероятно новичок. Я никогда раньше не использовал переполнение стека, просто просмотрел предыдущие вопросы.
Так должен ли код обновлять столбец «Уже использовано» на «Да» при назначении местоположения?
Я не знал, что это вариант, но если это поможет, то да. В настоящее время это просто формула ЕСЛИ/ВПР, ссылающаяся на еще один лист.
См. редактирование, чтобы добавить arrLstAtoE(y, 4) = "Yes" 'flag as used
Я могу помочь вам в автономном режиме, если у вас все еще возникают проблемы, но чтобы это работало, вам нужно будет поделиться своей книгой (например, по электронной почте).
Это сработало как шарм, Тим! Большое спасибо! Есть ли способ сделать «id» переменной, которая также могла бы содержать другие 38 уникальных кодов, которые она будет искать? как мне связаться с тобой в автономном режиме?
«Разбил мой Excel» на что именно похоже? - вы имеете в виду, что он просто работает долго или действительно вылетает?