Question

因此，我对VBA极为陌生，但必须完成一个需要对一些数据进行排序的项目。我有两张。一张工作表（称为“值”）具有一列值，我需要测试一个值是否与另一张非常大的工作表（“ sheet1”）中记录（行）的5列中的至少一列匹配，然后复制整个记录（行）到第二个电子表格（'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

我不确定我是否正确理解了你的问题。

Excel VBA代码，用于匹配值和复制整行

1 个答案: