我在A列中有一个描述,其中包含一些错误代码,如ESFB-1,ESFB-11等...表2中的错误代码列表共有大约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
请建议修改,以帮助我找到描述中的确切错误代码
答案 0 :(得分:1)
Instr
会给你一些误报,就像你要ESFB-1
&amp; 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
<强>截图强>