searchstring中单元格的确切值

我在列A中有一个描述，其中包含一些像ESFB-1，ESFB-11等错误代码…在sheet2中的错误代码列表总共有大约36个错误代码

我有下面的代码编写和工作，但唯一的问题是它同时治疗ESFB-1和ESFB-11相同的名单有大约35个类似的命名下面的错误代码是代码

enter code here Sub sear() Dim rng As Range Dim str As String Dim str1 As String Dim val1 As Long Dim val2 As Long Dim col As Integer Dim col2 As Integer Dim row2 As Integer Dim row As Integer Dim var As Integer Dim lastRow As Long Dim lastrow1 As Long Dim pos As Integer lastRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).row lastrow1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row var = 0 col = 1 row = 2 row2 = 2 pos = 0 Do While var <> 1 Do While row <= lastrow1 Do While pos = 0 str = Sheets("Sheet1").Cells(row, 1).Value str1 = Sheets("Sheet2").Cells(row2, 1).Value pos = InStrRev(str, str1, vbTextCompare) row2 = row2 + 1 If row2 = lastRow Then Exit Do Loop If pos <> 0 Then Cells(row, 7).Value = Sheets("Sheet2").Cells(row2 - 1, 1) End If Cells(row, 8).Value = pos & Sheets("Sheet1").Cells(row, 1) pos = 0 row2 = 2 row = row + 1 Loop var = 1 Loop End Sub 

请build议修改，可以帮助我从描述中find确切的错误代码

Answer 1

Instr会为您提供像ESFB-1和ESFB-11一样的误报，因此您需要更强大的检查。

这是你正在尝试？

 Sub Sample() Dim ws1 As Worksheet, ws2 As Worksheet Dim lRow As Long Dim Arws As Variant, tempAr As Variant Dim rng As Range, aCell As Range '~~> Set your sheets here Set ws1 = Sheet1: Set ws2 = Sheet2 With ws2 lRow = .Range("A" & .Rows.Count).End(xlUp).row '~~> Store the error codes in an array Arws = .Range("A1:A" & lRow) End With With ws1 lRow = .Range("A" & .Rows.Count).End(xlUp).row '~~> This is your range from 1st sheet Set rng = .Range("A2:A" & lRow) '~~> Loop through all cells and split it's contents For Each aCell In rng tempAr = Split(aCell.Value) '~~> Loop through each split word in the array For i = LBound(tempAr) To UBound(tempAr) '~~> Check if exists in array If ExistsInArray(Trim(tempAr(i)), Arws) Then '~~> If it does then write to col B aCell.Offset(, 1).Value = Trim(tempAr(i)) Exit For End If Next i Next aCell End With End Sub '~~> Function to check if a string is int he array Function ExistsInArray(s As String, arr As Variant) As Boolean Dim bDimen As Byte, i As Long On Error Resume Next If IsError(UBound(arr, 2)) Then bDimen = 1 Else bDimen = 2 On Error GoTo 0 Select Case bDimen Case 1 On Error Resume Next ExistsInArray = Application.Match(s, arr, 0) On Error GoTo 0 Case 2 For i = 1 To UBound(arr, 2) On Error Resume Next ExistsInArray = Application.Match(s, Application.Index(arr, , i), 0) On Error GoTo 0 If ExistsInArray = True Then Exit For Next End Select End Function 

截图