Nachschlagen mit Zahlen mit zusätzlichen Null am Ende

Question

Ich habe drei Blatt, Sheet1, Sheet2 und Sheet3. Sheet3 ist mein Ergebnisblatt.

Ich habe die ID in Spalte E von Blatt3, kopiert von Spalte P von Blatt1. Ich vergleiche die ID von Blatt3 mit der ID von Blatt2. Ich bin erfolgreich. aber ich habe ein Problem beim Vergleich. Die ID ist im Allgemeinen 11 bis 13 Ziffern lang. Case1, in einigen Fällen habe ich ID in Blatt 3 als D2C12682300 und in Sheet2 die gleiche ID wie D2C1268230000, in diesem Fall möchte ich, dass sie übereinstimmen, aber nach meinem Code wird es nicht übereinstimmen.

Fall2, in einigen Fällen habe ich die ID in Blatt3 als D2C12682300_id4576901 und in der Blatt2 habe ich die gleiche ID wie D2C1268230000. Ich möchte, dass sie übereinstimmen, aber mein Code funktioniert nicht so.

Könnte jemand vorschlagen, wie ich diese Bedingung in meinem Code einschließen könnte. Ich bin geschlagen, wie man es macht.

Unten ist der Code, den ich verwende, um ID von Blatt3 zu Blatt2 zu suchen. Ich möchte diese Fälle in diesen Code aufnehmen.

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

'Copy lookup values from sheet1 to sheet3 
ThisWorkbook.Sheets("S").Select 
lLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 
Range("P5:P" & lLastRow).Copy Destination:=Sheets("Result").Range("E5") 
Range("G5:G" & lLastRow).Copy Destination:=Sheets("Result").Range("H5") 
'Go to the destination sheet 
Sheets("Result_").Select 
For i = 5 To lLastRow 
'Search for the value on sheet2 
Set rng = Sheets("P").UsedRange.Find(Cells(i, 5).Value) 
'If it is found put its value on the destination sheet 
If Not rng Is Nothing Then 
Cells(i, 6).Value = rng.Value 
Cells(i, 1).Value = rng.Offset(0, 1).Value 
Cells(i, 2).Value = rng.Offset(0, 2).Value 
Cells(i, 3).Value = rng.Offset(0, 3).Value 
Cells(i, 4).Value = rng.Offset(0, 9).Value 
Cells(i, 9).Value = rng.Offset(0, 10).Value 
Cells(i, 12).Value = rng.Offset(0, 6).Value 
Cells(i, 13).Value = rng.Offset(0, 5).Value 
Cells(i, 14).Value = rng.Offset(0, 8).Value 
End If 
Next i 
End Sub 

Answer 1

Verwenden Sie eine Wildcard:

Set rng = Sheets("P").UsedRange.Find(Cells(i, 5).Value & "*", LookAt:=xlWhole) 

Vermeiden Sie auch .Select mit und objektivieren .Range, .Cells etc. lesen How to Avoid Select.