VBA: VLookUp Несколько результатов

Question

Мне нужна небольшая помощь с некоторым кодом.

Я пытаюсь выполнить ВПР, и имеет данные, отображаемые в колонках O, P и Q.

Что я пытаюсь сделать, это цикл, хотя лист («Global») колонка А начиная со строки 3 до последнего используемого ряда. Он должен сопоставлять данные на листе («Детали») в столбце А, начиная со строки 2.

Поэтому, когда он находит соответствующее значение, на нем будут отображаться результаты из «Детали» C2 в «Глобальном» O2 ». Подробности «I2 в« Глобальном »P2 и« Подробности »G2 в« Глобальном »Q2.

Для этого необходимо выполнить цикл «Глобальное» сопоставление и копирование всех данных. Если совпадение не найдено, отобразите «NA!».

Последнее, что мне нужно, это удалить все строки в Global, где совпадение не найдено.

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

Есть ли другой способ сделать это, что будет работать более плавно и быстрее?

Любая помощь приветствуется!

Спасибо

`Private Sub btnVlookUp_Click() 
Dim i, j, lastG, lastD As Long 

' find last row 
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row 
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row 

' loop over values in "Global" 
For i = 3 To lastG 
    lookupVal = Sheets("Global").Cells(i, "B") ' value to find 

    ' loop over values in "details" 
    For j = 2 To lastD 
     currVal = Sheets("Details").Cells(j, "A") 

     If lookupVal = currVal Then 
      Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C") 
      Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I") 
      Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G") 
      ' mark the row 
      Sheets("Details").Cells(j, "Z") = "marked" 

     End If 
    Next j 
Next i 

' loop over rows in "details" and delete rows which have not been marked 
For j = 2 To lastD 
    If Sheets("Details").Cells(j, "Z") <> "marked" Then 
     ' delete unmarked rows 
     Sheets("Details").Cells(j, "A").EntireRow.Delete 
     If Sheets("Details").Cells(j, "B") <> "" Then 
      j = j - 1 ' revert iterator so it doesn't skip rows 
     End If 
    Else: 
     ' remove the mark 
     Sheets("Details").Cells(j, "Z") = "" 
    End If 
Next j 
End Sub` 

Answer 1

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

Прежде всего, если вы добавите в начало кода строку Application.ScreenUpdating = False, это прекратит выполнение Excel из всех мерцаний и вспышек, которые вы видите во время выполнения кода (который фактически добавляет в эти значения один одним удалением строк и т. д., которые занимают много времени).

Далее вы можете добавить Exit For в конце своего заявления If (прямо перед вашим End If). Это остановит вложенный цикл For Loop, чтобы предотвратить прохождение всех данных, когда вы уже нашли то, что ищете.

Наконец, я знаю, что вы используете j = j - 1, чтобы настроить итератор, чтобы не пропускать строки, но лучше использовать вместо этого противоположное направление. Если вы измените For Loop на чтение For j = lastD to 2 Step -1, он заставит Loop работать в обратном порядке, поэтому удаленные строки не являются проблемой, и вы можете удалить строку «reset» (это будет едва ускорить ваш код, это просто больше предложение о том, как справиться с этой общей проблемой).

Answer 2

Ваш код очень неэффективен, как написано, поэтому он берет навсегда. Вы не указали конкретно, сколько строк находится в ваших «глобальных» и «подробных» листах (вы упомянули 800, не уверены, что это оба). Но если в каждой из них было 1000, ваши две петли 1000х1000 = 1 миллион циклов.

Лучшее решение - не использовать VBA вообще, но использовать функцию VLOOKUP в Excel. Вот что вам нужно сделать:

Сортировка Подробности лист по Колонка A Затем в Глобальном листе в ячейке O3, вы поставите следующую формулу: = ВПР (A3, информация!$ A2: $ I (независимо от последней строки), 3, FALSE)

Если вы не знакомы с этой функцией, она принимает первый аргумент, просматривает его в первом столбце второго аргумента, пока он находит совпадение, а затем возвращает значение в этой строке в столбце третьего аргумента. Последний «FALSE» дает вам только точное совпадение, иначе вы получите #NA (если вы используете TRUE, вы получите самое близкое совпадение).

Затем скопируйте эту формулу по всему листу.

Затем скопируйте столбец и вставьте значения. Это избавляет от форумала и просто оставляет ценности, что делает все намного быстрее.

Затем сортируйте таблицу по этому столбцу, и все #NA будут падать вместе, и вы можете удалить все это за одну операцию.

Если вы хотите сделать это с помощью VBA, описанные выше шаги могут легко быть закодированы:

Private Sub btnVlookUp_Click() 
Dim i, j, lastG, lastD As Long 
Dim DetailsTable as Range 

' find last row 
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row 
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row 

' Make sure this is sorted. If not, you'll need to add a sort command 
Set DetailsTable=Sheets("Details").Range(Sheets("Details").Cells(1, 2), Sheets.Cells(lastD, 9)) 

Sheets("Global").Range("O3")="=VLOOKUP(A3," & DetailsTable.address(external:=true) & "3,FALSE)" 
Sheets("Global").Range("O3").copy destination:=Sheets("Global").Range(Sheets("Global").cells(3,"O"),Sheets("Global").cells(lastG,"O")) 

End Sub 

Это начало, но вы должны получить идти. Удачи!

Answer 3

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

Я протестировал это на более чем 600 записях, и он работает в секундах, где это потребовало бы минут на предыдущем коде.

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

Спасибо за поддержку !!!!!!!!

Private Sub btnVlookUp_Click() 
Dim i, j, lastG, lastD As Long 
With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
    .CutCopyMode = False 
End With 
' find last row 
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row 
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row 

' loop over values in "Global" 
For i = 2 To lastG 
    lookupVal = Sheets("Global").Cells(i, "B") ' value to find 

    ' loop over values in "details" 
    For j = 2 To lastD 
     currVal = Sheets("Details").Cells(j, "A") 

     If lookupVal = currVal Then 
      Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C") 
      Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I") 
      Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G") 
      ' mark the row 
      Sheets("Details").Cells(j, "Z") = "marked" 
      Sheets("Details").Cells(1, "Z") = "marked" 
     Exit For 
     End If 
    Next j 
Next i 

On Error Resume Next 
Sheets("Details").Columns("Z").SpecialCells(xlBlanks).EntireRow.Delete 
Sheets("Details").Columns("Z").ClearContents 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
    .CutCopyMode = True 
End With 

End Sub