Использование rangefind

У меня есть три листа, лист S, лист P и данные листа.

Сначала я копирую столбец листа S в лист данных. Затем в столбце E данных листа я ищу идентификатор. Идентификатор В столбце E листа данных совпадает с столбцом A листа P, затем я копирую соответствующий идентификатор.

Проблема здесь заключается в том, что данные Листа содержат 214 строк, в то время как лист P содержит 1110. При сравнении идентификатора есть два разных идентификатора из строк 870 и 871, которые не копируются, хотя они одинаковы.

Может ли кто-нибудь руководствоваться тем, что может быть причиной?

Sub lookup() Dim lLastrow, totalrows As Long Dim rng As Range Dim i As Long 'Copy lookup values from S to Data With Sheets("S") lLastrow = .Cells(.Rows.count, 1).End(xlUp).Row .Range("P5:P" & lLastrow).Copy Destination:=Sheets("Data").Range("E5") .Range("G5:G" & lLastrow).Copy Destination:=Sheets("Data").Range("H5") End With totalrows = Sheets("P").Cells(Sheets("P").Rows.count, "A").End(xlUp).Row For i = 5 To lLastrow 'Search for the value on P_APQP With Sheets("P") Set rng = .Columns(1).Find(Sheets("Data").Cells(i, 5).Value & "*", lookat:=xlWhole) End With 'If it is found put its value on the destination sheet If Not rng Is Nothing Then With Sheets("Data") .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, 13).Value = rng.Offset(0, 6).Value .Cells(i, 14).Value = rng.Offset(0, 5).Value .Cells(i, 15).Value = rng.Offset(0, 4).Value .Cells(i, 16).Value = rng.Offset(0, 8).Value End With End If Next i End Sub 

Я отправлю весь код. Я также сделал корректировку вашей первой строки деклараций – как и у вас, только тоталы объявлялись длинными. Я должен бояться.

 Sub lookup() Dim lLastrow As Long, totalrows As Long Dim rng As Range Dim i As Long With Sheets("S") lLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row .Range("P5:P" & lLastrow).Copy Destination:=Sheets("Data").Range("E5") .Range("G5:G" & lLastrow).Copy Destination:=Sheets("Data").Range("H5") End With totalrows = Sheets("P").Cells(Sheets("P").Rows.Count, "A").End(xlUp).Row For i = 5 To lLastrow 'Search for the value on P_APQP With Sheets("P") 'amended below Set rng = .Columns(1).Find(Trim(Sheets("Data").Cells(i, 5).Value) & "*", lookat:=xlWhole) End With 'If it is found put its value on the destination sheet If Not rng Is Nothing Then With Sheets("Data") .Cells(i, 6).Value = rng.Value .Cells(i, 1).Resize(, 3).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, 13).Value = rng.Offset(0, 6).Value .Cells(i, 14).Value = rng.Offset(0, 5).Value .Cells(i, 15).Value = rng.Offset(0, 4).Value .Cells(i, 16).Value = rng.Offset(0, 8).Value End With End If Next i End Sub 
Давайте будем гением компьютера.