找到完全匹配时出错

Question

我有三张纸，Sh1，Sh2，Sh3。 Sh3是我的结果表。

我已在列E中将列N从Sh1复制到Sh3。

我考虑了sheet3的E列，然后我比较了sheet2的A列，如果它们匹配，那么我将把结果复制到F列的sheet3中。

我能够找到匹配的列，但是，我有一些特殊情况，我无法理清。

我在图片中解释过它们。

squash

![Here i have shown both structure of ID. The first row id is the same, and has no Problem ist finding the match. In the second row, there is an 0 less in my sheet2, and the code Fails to Display that, in row 3, the Id has an 0 extra in sheet2. in row 4, i have an id with other id, but in sheet2, i have the same id, with 0 extra, same in row 5 as well, The ID are generally 11 to 13 Digit Long. ] 1

有人可以建议我如何克服这个问题。下面是代码，我用于将值从一个工作表复制到另一个工作表并在另一个工作表中查找值。

[![The Image Shows an example of how the ID Looks in column E of sht3][1]][1]

Answer 1

我会做那样的事情：

Sub clear(rng As Range)
    For Each cell In rng.Cells
        cell.Value = Split(cell.Value, ",")(0)
        cell.Value = Split(cell.Value, ";")(0)
        While Mid(cell.Value, Len(cell.Value)) = "0"
            cell.Value = Mid(cell.Value, 1, Len(cell.Value) - 1)
        Wend
    Next cell
End Sub


Sub lookup()
    Dim lLastrow As Long
    Dim rng As Range
    Dim i As Long

    ThisWorkbook.Sheets("S").Select
    lLastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    Range("P5:P" & lLastrow).Copy Destination:=Sheets("Result_APQP").Range("E5")
    Range("G5:G" & lLastrow).Copy Destination:=Sheets("Result_APQP").Range("H5")

    Call clear(Sheets("Result").UsedRange)
    Call clear(Sheets("P").UsedRange)

    Sheets("Result").Select
    For i = 5 To lLastrow

        Set rng = Sheets("P").UsedRange.Find(Cells(i, 5).Value & "*", LookAt:=xlWhole)
        'If it is found put its value on the destination sheet
        If Not rng Is Nothing Then
            Cells(i, 6).Value = rng.Value
        End If
    Next i
End Sub

注意，clear（）子程序会修改原始数据。