VBA - 抛出异常以获取更多输出错误的数字

VBA - throwing exceptions to grab more numbers for output errors

我有代码强制任何 CT 值的长度为 "CT-" 之后的 4 个数字的长度，并且对 TL 值执行相同的长度为 "TL-" 之后的 6 个数字的长度。如果太短，则在"TL-"后加0；如果太长，则在 "TL-" 之后删除 0； CT也是一样。

我遇到的问题 运行 是我需要获取最多两个位于 CT 值之后的破折号之后的数字。它只需要在那个破折号之后并且只获取紧随其后的值，否则它将把它们网格化在一起。

我之前解决 "TL-" 代码问题的问题是 如果它有用的话。

示例：

当前输出

Start:               Output:
CT-0087(TC-7988)     CT-0087
CT-0067-02           CT-0067
CT-0076-REV01        CT-0076
CT-0098-1 A          CT-0098

期望的输出

Start:               Desired Output:
CT-0087(TC-7988)     CT-0087
CT-0067-02           CT-0067-02
CT-0076-REV01        CT-0076-01
CT-0098-1 A          CT-0098-1

所以应该总是有一个“-”和最多 2 个数字可以抓取，但我只希望它在破折号紧随其后时抓取它（潜在错误：CT-0087 不应该成为 CT -877988 由于抓取数字或破折号后的数字），我不知道如何针对该特定问题抛出异常。任何想法都会很有帮助！

在代码中：

'force length of TL/CT to be 6/4 numbers long, eliminate spaces

            Dim str As String, ret As String, k As Integer

            For k = 2 To StartSht.Range("C2").End(xlDown).Row
                ret = ""
                str = StartSht.Range("C" & k).Value

                ret = ExtractNumberWithLeadingZeroes(str, "TL", 6)
                If ret <> "" Then
                    StartSht.Range("C" & k).Value = "TL-" & ret
                Else

                    'for CT numbers
                    ret = ExtractNumberWithLeadingZeroes(str, "CT", 4)
                    If ret <> "" Then
                        StartSht.Range("C" & k).Value = "CT-" & ret
                    End If

                End If
            Next k

函数：

Public Function ExtractNumberWithLeadingZeroes(ByRef theWholeText As String, ByRef idText As String, ByRef numCharsRequired As Integer) As String

' Finds the first entry of idText in theWholeText
' Returns the first number found after idText formatted
' with leading zeroes

Dim i As Integer
Dim j As Integer
Dim thisChar As String
Dim returnValue As String
Dim tmpText As String
Dim firstPosn As Integer
Dim secondPosn As Integer

    returnValue = ""
    firstPosn = InStr(1, theWholeText, idText)
    If firstPosn > 0 Then
        ' remove any text before first idText, also remove the first idText
        tmpText = Mid(theWholeText, firstPosn + Len(idText))
        'if more than one idText value, delete everything after (and including) the second idText
        secondPosn = InStr(1, tmpText, idText)
        If secondPosn > 0 Then
            tmpText = Mid(tmpText, 1, secondPosn)
        End If
        ' Find first number
        For j = 1 To Len(tmpText)
            If IsNumeric(Mid(tmpText, j, 1)) Then
                tmpText = Mid(tmpText, j)
                Exit For
            End If
        Next j
        ' Find where the numbers end
        returnValue = tmpText
        For j = 1 To Len(returnValue)
            thisChar = Mid(returnValue, j, 1)
            If Not IsNumeric(thisChar) Then
                returnValue = Mid(returnValue, 1, j - 1)
                Exit For
            End If
        Next j
        'force to numCharsRequired numbers if too short; add 0s immediately after idText
        'force to numCharsRequired numbers if too long; eliminate 0s immediately after idText
        ' The CLng gets rid of leading zeroes and the Format$ adds any required up to numCharsRequired chars
        returnValue = Format$(CLng(returnValue), String(numCharsRequired, "0"))
    End If

    ExtractNumberWithLeadingZeroes = returnValue

End Function

这是一个函数，它将 return 您在上面指定的内容：

===========================================

Option Explicit
Function ExtractCode(S As String) As String
    Dim RE As Object, MC As Object

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = False
    .ignorecase = False  'could be true if you want
    .Pattern = "(CT-)\d*?(\d{4})(?!\d)(?:(-)\D*(\d{1,2}))?.*"

    S = Replace(S, "CT-", "CT-000") 'add leading zero's to pad to 4 if necessary

    If .test(S) = True Then
        ExtractCode = .Replace(S, "")
    Else
        ExtractCode = ""
    End If
End With

结束函数

这里有一些例子：

这里是正则表达式的正式、简短的解释：

(CT-)\d*?(\d{1,4})(?!\d)(?:(-)\D*(\d{1,2}))?.* 

(CT-)\d*?(\d{1,4})(?!\d)(?:(-)\D*(\d{1,2}))?.*

选项：区分大小写； ^$ 不匹配换行符

$1$2$3$4

创建于RegexBuddy