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

时间:2015-07-03 15:27:43

标签: excel vba excel-vba exception-handling

我的代码强制任何CT值的长度为“CT-”之后4个数字的长度,并且TL值与“TL-”之后的长度6相同。如果太短,则在“TL-”之后添加0;如果太长,则在“TL-”之后立即删除0; CT也一样。

我遇到的问题是我需要获取最后两个数字,这些数字来自CT值之后的破折号。它只需要在那个破折号之后,只抓住紧随其后的值,或者将它们连接在一起。

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

示例:

当前输出

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

1 个答案:

答案 0 :(得分:1)

这是一个函数,它将返回您在上面指定的内容:

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

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, "$1$2$3$4")
    Else
        ExtractCode = ""
    End If
End With

结束功能

以下是一些例子:

enter image description here

以下是正则表达式的正式简要说明:

(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

创建