我的代码强制任何TL值的长度为“TL-”之后的6个数字的长度，并且在“CT-”之后CT值与长度4相同。如果太短，则在“TL-”之后添加0;如果它太长，则在“TL - ”之后立即删除0。
TL- 0012 -> TL-000012
TL-0008981 -> TL-008981
TL - 008 -> TL-000008
代码在找到字符串“TL”后得到6个数字，将“TL-”放入单元格，然后放入6个数字。我遇到了一些我没有成功解决的问题。
主要问题： 如果存在更多数字，它将获取所有这些数字。
出现的另一个故障排除问题是，如果有另一个TL值，它将获取所有数字并添加它。现在，它将看到字符串“TL”第二次出现，并删除它及其后的任何内容。我希望在其他问题上应用相同类型的修复。
示例输出：
Start: Output:
TL-000487 #3 5/7" Cutter TL-487357
TL-000037(N123t3-01) TL-37123301
TL-000094 CTAT15123 TL-9415123
TL-000187 TL-00017 TL-000678 TL-000187
TL-000205 TL-000189 TL-000205
TL-000996:.096 REAMER TL-996096
TL-002313-(MF-4965) TL-23134965
期望输出：
Start: Output:
TL-000487 #3 5/7" Cutter TL-000487
TL-000037(N123t3-01) TL-000037
TL-000094 CTAT15123 TL-000094
TL-000187 TL-00017 TL-000678 TL-000187
TL-000205 TL-000189 TL-000205
TL-000996:.096 REAMER TL-000996
TL-002313-(MF-4965) TL-002313
如果有人可以帮助我解决这些问题，我会发现它提供了最丰富的信息和帮助。
CODE：
'force length of TL/CT to be 6/4 numbers long, eliminate spaces
Dim str As String, ret As String, tmp As String, j As Integer, k As Integer
For k = 2 To StartSht.Range("C2").End(xlDown).Row
ret = ""
str = StartSht.Range("C" & k).Value
'for TL numbers
If InStr(str, "TL") > 0 Then
'if more than one TL value, delete everything after the first TL number
If InStr(3, str, "TL") > 0 Then str = Mid(str, 1, InStr(3, str, "TL") - 2)
For j = 1 To Len(str)
tmp = Mid(str, j, 1)
If IsNumeric(tmp) Then ret = ret + tmp
Next j
'force to 6 numbers if too short; add 0s immediately after "TL-"
For j = Len(ret) + 1 To 6
ret = "0" & ret
Next j
'force to 6 numbers if too long; eliminate 0s immediately after "TL-"
If Len(ret) > 6 Then
Debug.Print Len(ret)
For j = Len(ret) To 7 Step -1
If Mid(ret, 1, 1) = "0" Then
ret = Right(ret, j - 1)
End If
Next j
End If
'eliminate superfluous spaces around "TL-"
ret = "TL-" & ret
StartSht.Range("C" & k).Value = ret
'for CT numbers
ElseIf InStr(str, "CT") > 0 Then
For j = 1 To Len(str)
tmp = Mid(str, j, 1)
If IsNumeric(tmp) Then ret = ret + tmp
Next j
'force to 4 numbers if too short; add 0s immediately after "CT-"
For j = Len(ret) + 1 To 4
ret = "0" & ret
Next j
'force to 4 numbers if too long; eliminate 0s immediately after "CT-"
If Len(ret) > 4 Then
Debug.Print Len(ret)
For j = Len(ret) To 5 Step -1
If Mid(ret, 1, 1) = "0" Then
ret = Right(ret, j - 1)
End If
Next j
End If
'eliminate superfluous spaces around "CT-"
ret = "CT-" & ret
StartSht.Range("C" & k).Value = ret
End If
Next k
修改 CT问题
现在是
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（TC-7988）不应该是CT- 0087-79）并且我不知道如何针对该特定问题抛出异常。想法？
答案 0 :(得分：1)
如果TL - ######总是你可以使用的前9个字符。
如果破折号不是第3个字符，我已经改变了一点。
Dim iIndex As Integer
'If there is a space between TL and - "TL -" let's get rid of it.
iIndex = InStr(str, " ")
If iIndex = 3 Then
str = Replace(str, " ", "", 1, 1)
End If
If Left(str, 2) = "TL" Then
TL = Left(str, 9)
TL = padZeros(TL, 6)
StartSht.Range("C" & k).Value = TL
ElseIf Left(str, 2) = "CT" Then
CT = Left(str, 7)
CT = padZeros(CT, 4)
StartSht.Range("C" & k).Value = CT
Else
MessageBox.Show ("We got a string we didn't expect.")
End If
对于您的短号添加类似
的功能Function padZeros(szinput As String, lenght As Integer) As String
Dim temp As String
temp = Trim(Right(szinput, 6))
temp = Replace(temp, "-", "")
temp = Replace(temp, " ", "")
szinput = Left(szinput, 3)
Do While lenght > Len(temp)
temp = "0" & temp
Loop
padZeros = szinput & temp
End Function
答案 1 :(得分：1)
我会做一些不同的事情。
Instr函数的结果存储在变量Format$函数。要删除前导零，可以使用CLng将字符串转换为长整数。这是功能：
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
你可以这样调用这个函数：
ret = ExtractNumberWithLeadingZeroes(str, "TL", 6)
你会得到类似＆＃34; 000487＆＃34;。
您的原始代码块变为：
'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
编辑：OP澄清了他的立场，因此我重写了ExtractNumberWithLeadingZeroes功能，并在下面添加了新版本：
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 returnValue As String
Dim extraValue As String
Dim tmpText As String
Dim firstPosn As Integer
Dim secondPosn As Integer
Dim ctNumberPosn 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
returnValue = ExtractTheFirstNumericValues(tmpText, 1)
If idText = "CT" Then
ctNumberPosn = InStr(1, tmpText, returnValue)
' Is the next char a dash? If so, must include more numbers
If Mid(tmpText, ctNumberPosn + Len(returnValue), 1) = "-" Then
' There are some more numbers, after the dash, to extract
extraValue = ExtractTheFirstNumericValues(tmpText, ctNumberPosn + Len(returnValue))
End If
End If
'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
If returnValue <> "" Then
returnValue = Format$(CLng(returnValue), String(numCharsRequired, "0"))
If extraValue <> "" Then
returnValue = returnValue & "-" & extraValue
End If
End If
End If
ExtractNumberWithLeadingZeroes = returnValue
End Function
Private Function ExtractTheFirstNumericValues(ByRef theText As String, ByRef theStartingPosition As Integer) As String
Dim i As Integer
Dim j As Integer
Dim tmpText As String
Dim thisChar As String
' Find first number
For i = theStartingPosition To Len(theText)
If IsNumeric(Mid(theText, i, 1)) Then
tmpText = Mid(theText, i)
Exit For
End If
Next i
' Find where the numbers end
For j = 1 To Len(tmpText)
thisChar = Mid(tmpText, j, 1)
If Not IsNumeric(thisChar) Then
tmpText = Mid(tmpText, 1, j - 1)
Exit For
End If
Next j
ExtractTheFirstNumericValues = tmpText
End Function