我的代码强制任何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
答案 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
以下是一些例子:
以下是正则表达式的正式简要说明:
?(CT-)\d*?(\d{1,4})(?!\d)(?:(-)\D*(\d{1,2}))?.*
选项:区分大小写; ^ $不匹配的换行
(CT-)
\d*?
(\d{1,4})
(?!\d)
(?:(-)\D*(\d{1,2}))?
.*
$ 1 $ 2 $ 3 $ 4
创建