Question

My requirement is when a user entered data in columnA of sheet1 then it should look for a match in columnA of sheet2 if found then all the corresponding rows should be pulled to sheet1.In some cases for the entry in columnA of sheet1 there will be multiple matches in columnA of sheet2. In those scenarios i want all the duplicates data also to get pulled into sheet1.This required function is fullfilled with my following code.But i am facing few challenges as 1.For an example when three inputs are entered in ColumnA of sheet1, if only matches are found for only two inputs then they should be pulled to the corresponding rows of the input leaving the third input at last row.

enter image description here 2.The other challenge is When duplicates are found, all duplicates should be one next to each other before pulling data of other input.

enter image description here 3.When no match is found for any of the inputs should show match not found message box. Below is the code which helped to some extent.

    Sub Getdata()
    Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Dim vDB, vCr, vR()
Dim i As Long, k As Long, N As Long, j As Integer
Dim r As Long, C As Integer
Dim lRow As Long, lCol As Long
Set Ws1 = Sheets("MARSDATA")
Set Ws2 = Sheets("MARS")

If WorksheetFunction.CountA(Range("A3:A50")) = 0 Then
    MsgBox "Not Found"
Exit Sub
End If

With Ws1
    r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    C = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    vDB = .Range("A4", .Cells(r, C))
End With
With Ws2
    r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    C = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    vCr = .Range("a1", .Cells(r, C))
End With

'vDB = Ws1.Range("a1").CurrentRegion
'vCr = Ws2.Range("a1").CurrentRegion
C = UBound(vDB, 2)
For i = 4 To UBound(vCr, 1)
    For k = 1 To UBound(vDB, 1)
        If vCr(i, 1) = vDB(k, 1) Then
            N = N + 1
            ReDim Preserve vR(1 To C, 1 To N)
            For j = 1 To C
                vR(j, N) = vDB(k, j)
            Next j
        End If
    Next k
Next i
With Ws2

lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    .Range(.Cells(lRow + 1, 1), .Cells(lRow + 1, lCol)).Resize(N, 26) = WorksheetFunction.Transpose(vR)

End With

End Sub

Answer 1

好吧，我更像是一个黑客而不是程序员，所以这是一个非常肮脏的解决方案，但这就是我要做的。

搜索数值并找出数据的存在位置（如果存在）。
如果是，请从该行获取数据。
将行号存储在变量中。
单步执行一个单元格并进行新搜索。
如果找到其他值，请检查以确保行号不相同。这表明您已将数据循环回到开头。

重复步骤4和5，直到获得原始行号。

Match column A of sheet1 data with column A of sheet2 and pull all corresponding rows to sheet1 including duplicates

1 个答案: