Найти точное совпадение числа в текстовую строку со случайными буквами и цифрами - PullRequest
0 голосов
/ 04 января 2019

У меня есть только числа в Листе 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

Спасибо.

Ответы [ 2 ]

0 голосов
/ 04 января 2019

Возможно, вы можете включить это в свой код. Он использует регулярные выражения. Это удивительно длинный шаблон для поиска простого числа.

Это просто номер 81.

Sub x()

Dim oRgx As Object, rCell As Range

Set oRgx = CreateObject("VBScript.RegExp")

With oRgx
    .Global = True
    .Pattern = "([^0-9]|^)81([^0-9]|$)"
    For Each rCell In ActiveSheet.UsedRange
        If .Test(rCell) Then MsgBox rCell.Address
    Next rCell
End With

End Sub

enter image description here

0 голосов
/ 04 января 2019

Я думаю, что вы можете просто использовать формулу, в этом примере проверяется 30 в abc30ded435wdfq345, например

=IF(ISERROR(SEARCH(30,J16,1)),"No Match","Match")

Не уверен, что я полностью понимаю вашу проблему.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...