Код Excel VBA для сопоставления значений и копирования всей строки

Question

Так что я очень плохо знаком с VBA, но мне нужно закончить проект, который требует сортировки некоторых данных.У меня есть два листа.На одном листе (называемом «значениями») есть один столбец значений, который мне нужно проверить, соответствует ли значение хотя бы одному из 5 столбцов записи (строки) на другом очень большом листе («sheet1»), и скопируйтевся запись (строка) для второй электронной таблицы ('sheet2).

Это мой псевдокод:

for each row in sheet1 where sheet1.row = A1:Q1231231
for each value in values  where values.value = b1:b300
    for each col (e1:j1) where sheet1.col = E-rownum : J-rownum
        if value == col-value 
            copy row to sheet2
            break, esc value 
Next row

И это то, что у меня есть, но я немногоЗастрял ли я ссылки все правильно.Как мне просто получить столбцы E: J для каждой строки, когда мне нужно сопоставить значения только с этими ячейками?Как мне скопировать всю строку, если есть совпадение, и сразу же разбить и перейти к следующей записи?

Private Sub CommandButton1_Click()

    Dim sheetrow As Range
    Dim Values As Range
    Dim cells As Range

    Set Sheet1 = Worksheets("Sheet1")
    Set Values = Worksheets("values").Rows("B2:B330")
    Set Sheet2 = Worksheets("Sheet2")


    For Each sheetrow In Sheet1.Rows
        For Each value In Values
            For Each cell In sheetrow.cells // only need cell cols E:J
                //if value == cell
                // copy row to sheet2
                //break (no need to check the rest of the row if match)
            Next
        Next
    Next
End Sub

Просто чтобы сообщить, что это не для назначения VBA.Это просто очень большой объем данных, и скрипт будет работать лучше, чем пытаться вручную пройти через него.Большое вам спасибо!

Answer 1

Ваш псевдокод выглядит хорошо, хотя я удалил 3-й цикл, хотя, конечно, вы могли бы циклически проходить по столбцам.

Это то, что вы ищете?

Option Explicit
Sub Test()
     Dim i As Long
     Dim j As Long
     Dim rngValues As Range
     Dim rng As Range
     Dim Sheet1 As Worksheet
     Dim Sheet2 As Worksheet

     Application.ScreenUpdating = False 'Turns of Screenupdating to let the code run faster
     Set Sheet1 = ThisWorkbook.Sheets("Sheet1")
     Set Sheet2 = ThisWorkbook.Sheets("Sheet2")
     Set rngValues = ThisWorkbook.Sheets("Values").Range("B2:B330")
     j = 1 'counter to count up the rows on the destination sheet
     For i = 1 To Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row 'determines the last row on Sheet1
         For Each rng In rngValues
             'default return value of range is the value in it, so there would be no need to use range.value
             ' _ continues the code in the next line for readability
             If Sheet1.Cells(i, 5).Value = rng.Value or Sheet1.Cells(i, 6).Value = rng.Value Or Sheet1.Cells(i, 7).Value = rng.Value or _ 
             Sheet1.Cells(i, 8).Value = rng.Value or Sheet1.Cells(i, 9).Value = rng.Value Or Sheet1.Cells(i, 10).Value = rng.Value Then
                  'This copies the entire row an parses it to destination
                  Sheet1.Cells(i, 1).EntireRow.Copy Destination:=Sheet2.Cells(j, 1)
                  j = j + 1
             End If
         Next
     Next
     Application.ScreenUpdating = True
End Sub

Я не уверен, правильно ли я понял ваш вопрос.