Question

如果这些数据存在于主页中，则我希望vba代码查找特定范围的数据，然后检索基于条件的最后一行数据。例如（有三行＆＃34; dler＆＃34;我想比较dler和三行第二张（如果所有存在都检索dler行），这意味着比较名称与其他行等等...图片是两张纸，第一张是（主页），第二张是vba在其上查找数据的表（主表）我有这个代码，但我不知道如何改变它的工作动态记录。

Main and Search Worksheet Image

Sub Matching_name()
    Dim a_name As String, i As Long, j As Long, Last_Row As Long

    For i = Last_Row To 2 Step -1
        a_name = Cells(i, "B").Value
        If City = "dler" Then
            'Set the range destination, Range(“A2”), depending on which
            'range you want in Sheets(“Remaining”)
            Rows(i).EntireRow.Copy Destination:=Worksheets("Remaining").Range("A1")
            Exit For
        End If

    Next i

End Sub

Answer 1

这将复制最后匹配的行

Sub Matching_name()

Dim i As Long, j As Long, k As Long, Last_Row As Long, temp As Long
Dim a_name As String, s_type As String, c_type As String

temp = 1
Last_Row = 6

For i = 2 To Last_Row
    Worksheets("Main Sheet").Activate
    a_name = Cells(i, 2).Value
    s_type = Cells(i, 5).Value
    c_type = Cells(i, 6).Value

    Worksheets("Search Sheet").Activate
    For j = 1 To 3
        If Cells(j, 1).Value = a_name And Cells(j, 2).Value = s_type And Cells(j, 3).Value = c_type Then
            Worksheets("Main Sheet").Activate
            Rows(i & ":" & i).Select
            Selection.Copy
            Worksheets("Remaining").Activate
            Rows(temp & ":" & temp).Select
            ActiveSheet.Paste
            temp = temp + 1
        End If
    Next j
Next i

Worksheets("Remaining").Activate
For x = temp To 1 Step -1
    y = 1
    While y <= temp
        If Cells(y, 2).Value = Cells(x, 2).Value And x <> y Then
            Rows(y & ":" & y).Delete
            y = y - 1
            temp = temp - 1
        End If
        y = y + 1
    Wend
Next x

End Sub

如果值存在，则检索此值的最后一行

1 个答案: