У меня есть только числа в Листе 2 в столбце B, начиная с B2: 81, 102 (в B3), 104 (в B4) и т. Д., И в Sheet1 в столбце A, начинающемся с A2, смешанный текст с нумерацией безЛогическое место текста, например: abc813bnm 12mn (в A2), fgh 81lkj 45ol (в A3), ert1042hji (в A4) и так далее.Мне нужно найти каждое число из col.B / Sheet2 в col.A / Sheet1 и записать точное совпадение в той же строке в col.Q, скажем так.Точное совпадение первого номера 81 в A3 (fgh 81lkj 45ol), но не в A2 (abc813bnm 12mn), где оно находится внутри строки 813.В моем коде 81 (и не только) он "найден" и в ячейке с 81 и в ячейке с 813, и я не хочу, чтобы:
Sub SearchLCL ()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim LCL1 As String
Dim LCL2 As String
'Dim answer As String
Dim c As Range
Dim counter As Long
Dim totalLCL1 As Long
Dim totalLCL2 As Long
counter = 2
'Sheets("MailElibLCL").Select 'Sheet2
'Sheets("lucrari 2017").Select 'Sheet1
totalLCL2 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
totalLCL1 = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
'totalLCL2 = N
'totalLCL1 = N3
For I = 2 To totalLCL2
'answer = Worksheets("hedis1").Range("h" & counter).Value
LCL2 = Worksheets("Sheet1").Range("A" & counter).Value
'LCL2 = "=MID(Worksheets.Sheet1.Range(""A"" & counter),SEARCH(LCL1,Worksheets.Sheet1.Range(""A"" & counter)),LEN(LCL1))"
k = "Q" & counter
For j = 2 To totalLCL1
LCL1 = Worksheets("Sheet2").Range("B" & j).Value
If InStr(1, LCL2, LCL1, vbTextCompare) > 0 Then
Debug.Print LCL1
'If LCL1 = LCL2 Then
'If answer = "Yes" Then
For Each c In Worksheets("Sheet1").Range(k)
'c.Value = Mid(LCL2, Search(LCL1, LCL2), Len(LCL1))
'c.Formula = "=MID(LCL2,INSTR(LCL1,LCL2),LEN(LCL1))"
'c.EntireRow.Interior.Color = 6 ' Change the number to match the desired color.
c.Value = LCL1 '& vbLf & Date 'Now (si ora minute secunde)
'c.Interior.Color = 5296210 ' Change the number to match the desired color.
Next c
'End If
'End If
End If
Next j
counter = counter + 1
Next I
'Else' Call ScrieMailElib 'End If
При ошибке GoTo 0
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Спасибо.