我的字符串提取代码有修复程序吗？

Question

我正在尝试从不同的字符串中提取一个具有随机位置的子字符串。替代不是固定值，而是 "T" 然后是四个数字，例如T6000.

正如您在此图像中看到的那样，有许多机器名称，其中大多数包含 T 编号。在几乎所有情况下，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

它只填充 'export' 范围 (F16:F25) 的第一个和最后一个单元格。

我一直在寻找答案。因为我（显然）不是VBA专家。

我做错了什么？为什么不填写其他值？

谢谢，沃特 J

Answer 1

问题出在您的变量 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
    ...

Answer 2

试试这个代码

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

我的字符串提取代码有修复程序吗？

Is there a fix for my string extraction code?

string

excel

vba

loops

extraction