Есть ли исправление для моего кода извлечения строки? - PullRequest
Новая
       14

Есть ли исправление для моего кода извлечения строки?

0 голосов
/ 10 мая 2019

Я пытаюсь извлечь подстроку, которая имеет случайную позицию из разных строк. Подстановка - это не фиксированное значение, а "Т", а затем четыре цифры, например T6000.

Please see this image.

Как вы можете видеть на этом изображении, есть несколько имен машин, большинство из которых содержат число T. Число Т также отличается почти во всех случаях. Столбец с именами машин - "E". Первый номер (T6000) в E16, последний в E25.

Используя мой код: 

For Ipattern = 16 To NumofMachines + 15 Step 1
    TNUMcell = Dsht.Range("E" & Ipattern).Value
    'Verify if string contains a Tnum
    TNUMLikeBoolean = TNUMcell Like "*T###*"

    If TNUMLikeBoolean = True Then
        Do Until TNUMdone = True
            TNUMchar1 = InStr(TNUMcell, "T") + 1
                TNUMcharV = Mid(TNUMcell, TNUMchar1)
                TNUMchecknum = IsNumeric(TNUMcharV)
                    If TNUMchecknum = True Then
                        Dsht.Range("F" & Ipattern).Value = "T" & Mid(TNUMcell, TNUMchar1, 5)
                        TNUMdone = True
                    End If
        Loop
    Else
        Dsht.Range("F" & Ipattern).Value = "NO T"
    End If
Next Ipattern

Заполняет только первую и последнюю ячейку диапазона экспорта (F16: F25).

Я довольно долго искал ответ. Поскольку я (очевидно) не эксперт VBA.

Что я делаю не так? Почему не заполняются другие значения?

Спасибо, Wouter J

Ответы [ 2 ]

4 голосов
/ 10 мая 2019

Попробуйте этот код 

Sub Test()
Dim r As Range, i As Long, c As Long

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "T\d{4}"

    For Each r In Range("E16", Range("E" & Rows.Count).End(xlUp))
        c = 6
        If .Test(r.Value) Then
            For i = 0 To .Execute(r.Value).Count - 1
                Cells(r.Row, c).Value = .Execute(r.Value)(i)
                c = c + 1
            Next i
        End If
    Next r
End With
End Sub
1 голос
/ 10 мая 2019

Проблема связана с вашей переменной TNUMdone.

. Она устанавливается на True на первой итерации цикла, а затем никогда не устанавливается на False, поэтому этот код после Do Until TNUMdone = Trueникогда не запускается снова.

В начале цикла просто установите TNUMdone на False, и оно должно работать: 

For Ipattern = 16 To NumofMachines + 15 Step 1
    TNUMdone = False
    TNUMcell = Dsht.Range("E" & Ipattern).Value
    ...
...