VBA – 在工作代码中引发特定错误的exception，IsNumeric问题？

如果标题模糊，我很抱歉。 我不知道如何引用这个问题。

我有强制任何TL值的长度为“TL-”之后6个数字的长度的代码，并且在“CT-”之后用CT值执行长度为4的代码。 如果太短，则在“TL-”之后加0。 如果太长，则在“TL-”之后从右侧删除0。

TL- 0012 -> TL-000012 TL-0008981 -> TL-008981 TL - 008 -> TL-000008 

findstring“TL”后，代码得到6个数字，把“TL-”放在单元格中，然后是六个数字。 我碰到了一些我没有成功修复的问题。

主要问题：如果有更多的号码存在，它将抓住所有这些号码。

其他排除故障的问题之一是如果有另一个TL值，它会抓住所有的数字，并添加它。 现在，将会看到string“TL”再次出现，并且删除它以及后面的任何内容。 我希望在其他问题上应用相同types的修复。

输出示例：

 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 

如果有人能帮我解决这些问题，我会发现它最有用的信息和帮助。

码：

 '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 

所以应该总是有一个“ – ”和最多两个数字来抓，但我只想要抓住它，如果破折号是紧接着的（CT-0087（TC-7988）不应该是CT-0087-79 ），我不知道如何抛出一个特殊问题的例外。 想法？

Answer 1

有几件事我会做不同的事情。

1. 我会将Instr函数的结果存储在一个variables中
2. 当您find第一个“TL”条目时，您将这些字符作为答案的一部分。 但这意味着您需要担心文本和数字之间的空格和连字符。 我会寻找第一个“TL”，然后从这个位置看连续的字符寻找第一个数字。 这是你的号码的开始。 在该angular色之前的任何东西都应该被移除。
3. 要使用前导零来格式化数字，您可以使用Format$函数。 要删除前导零，可以使用CLng将string转换为长CLng 。
4. 它看起来像你可能需要类似的代码，当你寻找“CT”，所以我build议创build一个返回数字的函数的代码。

这是function：

 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) 

你得到像“000487”。

你原来的代码块变成：

 '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澄清了他的立场，所以我已经重新编写了ExtractNumberWithLeadingZeroesfunction，并包括下面的新版本：

 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 

Answer 2

如果TL – ######始终是您可以使用的前九个字符。

如果破折号是不一致的第三个字符我已经改变了一下。

 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

 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