Question

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

我写了以下代码＆amp;有效，但唯一的问题是它同时处理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

请建议修改，以帮助我找到描述中的确切错误代码

Answer 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

<强>截图

在字符串中搜索单元格的精确值

1 个答案: