find匹配的ID时出错

我有两个工作表sheet1，sheet2

对于sheet1，我有一个始终以4开头的id，我在sheet2中查找这个ID，并将相应的名称复制回到sheet1。

ID总是8位长。

在这期间，我有一个特殊情况，身份证有一些特殊的字符和字符。 例如：41017734_dr_bad; 代码在这种情况下失败。 我没有认出第一个8，并没有粘贴在另一张纸上。

有人可以build议如何克服这一点？ 我有一个想法，我们可以使用whilcard和strlen函数。 但碰到如何在代码中使用。

Sub match() Dim sh1 As Worksheet, sh2 As Worksheet Dim cell As Range, cell2 As Range, lstcl As Variant, lstcl2 As Variant, rgFnd As Variant Dim n As Double, ID As String Set sh1 = ThisWorkbook.Sheets("S") Set sh2 = ThisWorkbook.Sheets("P") ID = "4" lstcl = sh1.Range("N10000").End(xlUp).Row lstcl2 = sh2.Range("L10000").End(xlUp).Row 'comparing columns N and L in both sheets For Each cell In sh2.Range("L5:L" & lstcl2) For n = 5 To lstcl If cell = sh1.Range("N" & n) Then 'the cell in column M next to the matching cell is equal to the 4xxxxxxx number cell.Offset(0, 1) = sh1.Range("N" & n) 'the next cell in column N is equal to the A2C number in column A cell.Offset(0, 2) = cell.Offset(0, -11) End If Next Next 'test that each cell in the first sheet corresponds to the located results in the second sheet _ 'and pastes back the A2C number, using the Range.Find function For Each cell2 In sh1.Range("N5:N" & lstcl) If Left(cell2, 1) = ID Then Set rgFnd = sh2.Range("M5:M" & lstcl2).Find(cell2.Value) If Not rgFnd Is Nothing Then cell2.Offset(0, 1) = sh2.Range(rgFnd.Address).Offset(0, 1) End If End If Next End Sub 

Answer 1

尝试这个

 Sub match() Dim sh1 As Worksheet, sh2 As Worksheet Dim cell As Range, cell2 As Range, lstcl As Variant, lstcl2 As Variant, rgFnd As Variant Dim n As Double, ID As String Set sh1 = ThisWorkbook.sheets("S") Set sh2 = ThisWorkbook.sheets("P") ID = "4" lstcl = sh1.Range("N10000").End(xlUp).Row lstcl2 = sh2.Range("L10000").End(xlUp).Row 'comparing columns N and L in both sheets For Each cell In sh2.Range("L5:L" & lstcl2) For n = 5 To lstcl a = Left(sh1.Range("N" & n), 8) If cell = a Then 'the cell in column M next to the matching cell is equal to the 4xxxxxxx number cell.Offset(0, 1) = a 'the next cell in column N is equal to the A2C number in column A cell.Offset(0, 2) = cell.Offset(0, -11) End If Next Next 'test that each cell in the first sheet corresponds to the located results in the second sheet _ 'and pastes back the A2C number, using the Range.Find function For Each cell2 In sh1.Range("N5:N" & lstcl) If Left(cell2, 1) = ID Then Set rgFnd = sh2.Range("M5:M" & lstcl2).Find(cell2.Value) If Not rgFnd Is Nothing Then cell2.Offset(0, 1) = sh2.Range(rgFnd.Address).Offset(0, 1) End If End If Next End Sub