始终打印出特定字符串后的 6 位数字
always print out 6 digits following specific string
我有许多名称为 "TL-" 的字符串，后跟 6 位数字（即 TL-000456、TL-000598）。有时它会打印出少于 6 位的数字（即 TL-09872、TL-345、TL-02）。
我希望我的代码在 "TL-" 之后添加一个零，直到它包含 6 位数字。
Start: Output:
TL-000456 -> TL-000456
TL-000598 -> TL-000598
TL-09872 -> TL-009872
TL-345 -> TL-000345
TL-02 -> TL-000002
如果可能，我希望它这样做，这样即使字符串中包含 space（即 "TL - "、"TL -"），6 位数字也始终是抓住了。
TL - 987 -> TL-000987
TL- 839 -> TL-000839
我的代码中有一个函数，它修剪 "TL" 值以获取分号或逗号之前的所有内容，因此理想情况下代码会放在那里。想法？
给出评论的当前尝试：
代码从 ws（工作表）中的 header "CUTTING TOOL" 下获取值并将其打印到 StartSht（带代码的工作簿）
(1) Returns Trim 行在有效程序或参数
中的错误
With WB
For Each ws In .Worksheets
Dim sIn, sOut As String
'find CUTTING TOOL on the source sheet
If Not ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then
Set hc = ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues)
Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
If dict.count > 0 Then
'add the values to the workbook, column 3
Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
'trim values **implement new code here**
With StartSht
Trim (Left(sIn, InStr(1, sIn, "-", vbTextCompare) - 1)) & "-" & Right("000000" & Trim(Right(sIn, Len(sIn) - InStr(1, sIn, "-", vbTextCompare))), 6)
End With
(2) 完全运行但不更改值
With WB
For Each ws In .Worksheets
'find CUTTING TOOL on the source sheet
If Not ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then
Set hc = ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues)
Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
If dict.count > 0 Then
'add the values to the master list, column 3
Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
Dim str As String, ret As String, tmp As String, j As Integer
With StartSht
For j = 1 To Len(str)
tmp = Mid(str, j, 1)
If IsNumeric(tmp) Then ret = ret + tmp
Next j
For j = Len(ret) + 1 To 6
ret = "0" & ret
Next
Debug.Print ret
End With
StartSht Excel 文件看起来像这样
A B C D
1 TDS HOLDER CUTTING TOOL File Name
2 TDS-1 H1 TL-000289 TDS-1.xlsx
3 TDS-2 H2 TL-000274 TDS-2.xlsx
4 TDS-3 H3 TL-0002 TDS-3.xlsx
5 TDS-4 H4 TL-0343 TDS-4.xlsx
在下面的 "CUTTING TOOL" 代码之后，它看起来就像代码下面的输出，因为那是我获取信息的第一部分
代码：
With WB
For Each ws In .Worksheets
'find CUTTING TOOL on the source sheet
If Not ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then
Set hc = ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues)
Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
If dict.count > 0 Then
'add the values to the master list, column 3
Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
StartSht 的输出：
A B C D
1 TDS HOLDER CUTTING TOOL File Name
2 TL-000289
3 TL-000274
4 TL-0002
5 TL-0343
我想添加一行 str = StartSht.Range(''set correct range here'') 然后编写代码使 StartSht 看起来像这样
A B C D
1 TDS HOLDER CUTTING TOOL File Name
2 TL-000289
3 TL-000274
4 TL-000002
5 TL-000343
对于提取数字，听起来你想要的是类似于\d{1,6}的正则表达式。然而，我从来没有真正享受过在 VBA 中使用正则表达式，所以另一种提取数字的方法是：
Sub Test()
Dim str as string, ret as string, tmp as string, i as integer
str = "T- 087652"
for i = 1 to len(str) 'vba strings are 1-indexed
tmp = mid(str, i, 1) 'get the character at position i
if IsNumeric(tmp) then ret = ret + temp 'if numeric, add to the return value
next i
debug.print ret 'print the resulting number to the console. To convert to a number, simply assign to a variable typed as "long"
End Sub
这是一个简单的前向循环遍历字符串，提取 IsNumeric 中的每个字符。它应该忽略字符串中出现的任何空格，但每个字符串不应超过一个整数。
为了格式化数字，您可能只想 pad the string。
将其放入新模块中：
Option Explicit
Public Function getDigits(strInput As String) As String
Dim strOutput As String
Dim strCharacter As String
Dim i As Integer
strOutput = ""
For i = 1 To Len(strInput)
strCharacter = Mid(strInput, i, 1)
If strCharacter >= "0" And strCharacter <= "9" Then
strOutput = strOutput & strCharacter
End If
Next
getDigits = strOutput
End Function
Public Function addZeros(strInput As String) As String
Dim intCurrentLength As Integer
Dim strNumber As String
Dim i As Integer
strNumber = getDigits(strInput)
intCurrentLength = Len(strNumber)
If intCurrentLength < 6 Then
For i = 1 To 6 - intCurrentLength
strNumber = "0" & strNumber
Next i
End If
addZeros = "TL-" & strNumber
End Function
然后 运行 addZeros([你的字符串]) 转换为所需的格式。
(for user4888 in the comments of this question; 如何检查 'TL' 是否在字符串中的示例。这将检查单元格 A1 到 A10，并在相应的单元格中填充 1 或 0在 B 列中取决于单元格中是否有 'TL'）
Private Sub TLcheck()
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
For i = 1 To 10
ws.Cells(i, 2) = InStr(1, ws.Cells(i, 1), "TL")
Next i
End Sub
扩展 Orphid 的答案以包含 6 位数字：
Sub Test()
Dim str as string, ret as string, tmp as string, i as integer, j as integer
for j = 2 to StartSht.Range("C2").End(xlDown).Row
ret = ""
str = StartSht.Range("C" & j).Value
for i = 1 to len(str)
tmp = mid(str, i, 1)
if IsNumeric(tmp) then ret = ret + tmp
next i
For i = Len(ret) + 1 To 6
ret = "0" & ret
Next
ret = "TL-" & ret
StartSht.Range("C" & j).Value = ret
next j
End Sub
这是要在原来的B栏旁边写'ret'。您正在处理的 sheet 在运行时需要处于活动状态，因为如您所见，我没有指定要使用哪个 Sheet。如果有必要，你可以自己做。为此，我假设只需要对 1 个工作簿中的 1 个工作sheet 完成。如果我错了，请告诉我。
这是单行本。我正在抓取连字符前后的数据，修剪它们以删除空格，并添加连字符和额外的 0。
Sub splitAddZeros()
Dim sIn, sOut As String
sIn = "TL - 987"
out = Trim(Left(sIn, InStr(1, sIn, "-", vbTextCompare) - 1)) & "-" & Right("000000" & Trim(Right(sIn, Len(sIn) - InStr(1, sIn, "-", vbTextCompare))), 6)
Debug.Print out
End Sub
到目前为止你尝试了什么？您有任何代码可以向我们展示吗？
这应该是一个起点，您当然需要去掉空格并循环遍历整个文件。
Public Sub PaddingTest()
Dim PaddingArray() As String
Dim PaddingVar As String
PaddingArray() = Split(Range("A1").Value, "-", 2, vbTextCompare)
PaddingVar = PaddingArray(1)
While Len(PaddingVar) < 6
PaddingVar = "0" & PaddingVar
Wend
Range("A2").Value = PaddingArray(0) & "-" & PaddingVar
End Sub
msdn.microsoft.com 拆分命令的用法
有一种使用 excel 公式的方法：
="TL-" & TEXT(TRIM(RIGHT(A1,LEN(A1)-FIND("-",A1,1))),"000000")
我有许多名称为 "TL-" 的字符串，后跟 6 位数字（即 TL-000456、TL-000598）。有时它会打印出少于 6 位的数字（即 TL-09872、TL-345、TL-02）。
我希望我的代码在 "TL-" 之后添加一个零，直到它包含 6 位数字。
Start: Output:
TL-000456 -> TL-000456
TL-000598 -> TL-000598
TL-09872 -> TL-009872
TL-345 -> TL-000345
TL-02 -> TL-000002
如果可能，我希望它这样做，这样即使字符串中包含 space（即 "TL - "、"TL -"），6 位数字也始终是抓住了。
TL - 987 -> TL-000987
TL- 839 -> TL-000839
我的代码中有一个函数，它修剪 "TL" 值以获取分号或逗号之前的所有内容，因此理想情况下代码会放在那里。想法？
给出评论的当前尝试：
代码从 ws（工作表）中的 header "CUTTING TOOL" 下获取值并将其打印到 StartSht（带代码的工作簿）
(1) Returns Trim 行在有效程序或参数
With WB
For Each ws In .Worksheets
Dim sIn, sOut As String
'find CUTTING TOOL on the source sheet
If Not ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then
Set hc = ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues)
Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
If dict.count > 0 Then
'add the values to the workbook, column 3
Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
'trim values **implement new code here**
With StartSht
Trim (Left(sIn, InStr(1, sIn, "-", vbTextCompare) - 1)) & "-" & Right("000000" & Trim(Right(sIn, Len(sIn) - InStr(1, sIn, "-", vbTextCompare))), 6)
End With
(2) 完全运行但不更改值
With WB
For Each ws In .Worksheets
'find CUTTING TOOL on the source sheet
If Not ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then
Set hc = ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues)
Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
If dict.count > 0 Then
'add the values to the master list, column 3
Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
Dim str As String, ret As String, tmp As String, j As Integer
With StartSht
For j = 1 To Len(str)
tmp = Mid(str, j, 1)
If IsNumeric(tmp) Then ret = ret + tmp
Next j
For j = Len(ret) + 1 To 6
ret = "0" & ret
Next
Debug.Print ret
End With
StartSht Excel 文件看起来像这样
A B C D
1 TDS HOLDER CUTTING TOOL File Name
2 TDS-1 H1 TL-000289 TDS-1.xlsx
3 TDS-2 H2 TL-000274 TDS-2.xlsx
4 TDS-3 H3 TL-0002 TDS-3.xlsx
5 TDS-4 H4 TL-0343 TDS-4.xlsx
在下面的 "CUTTING TOOL" 代码之后，它看起来就像代码下面的输出，因为那是我获取信息的第一部分
代码：
With WB
For Each ws In .Worksheets
'find CUTTING TOOL on the source sheet
If Not ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then
Set hc = ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues)
Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
If dict.count > 0 Then
'add the values to the master list, column 3
Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
StartSht 的输出：
A B C D
1 TDS HOLDER CUTTING TOOL File Name
2 TL-000289
3 TL-000274
4 TL-0002
5 TL-0343
我想添加一行 str = StartSht.Range(''set correct range here'') 然后编写代码使 StartSht 看起来像这样
A B C D
1 TDS HOLDER CUTTING TOOL File Name
2 TL-000289
3 TL-000274
4 TL-000002
5 TL-000343
对于提取数字，听起来你想要的是类似于\d{1,6}的正则表达式。然而，我从来没有真正享受过在 VBA 中使用正则表达式，所以另一种提取数字的方法是：
Sub Test()
Dim str as string, ret as string, tmp as string, i as integer
str = "T- 087652"
for i = 1 to len(str) 'vba strings are 1-indexed
tmp = mid(str, i, 1) 'get the character at position i
if IsNumeric(tmp) then ret = ret + temp 'if numeric, add to the return value
next i
debug.print ret 'print the resulting number to the console. To convert to a number, simply assign to a variable typed as "long"
End Sub
这是一个简单的前向循环遍历字符串，提取 IsNumeric 中的每个字符。它应该忽略字符串中出现的任何空格，但每个字符串不应超过一个整数。
为了格式化数字，您可能只想 pad the string。
将其放入新模块中：
Option Explicit
Public Function getDigits(strInput As String) As String
Dim strOutput As String
Dim strCharacter As String
Dim i As Integer
strOutput = ""
For i = 1 To Len(strInput)
strCharacter = Mid(strInput, i, 1)
If strCharacter >= "0" And strCharacter <= "9" Then
strOutput = strOutput & strCharacter
End If
Next
getDigits = strOutput
End Function
Public Function addZeros(strInput As String) As String
Dim intCurrentLength As Integer
Dim strNumber As String
Dim i As Integer
strNumber = getDigits(strInput)
intCurrentLength = Len(strNumber)
If intCurrentLength < 6 Then
For i = 1 To 6 - intCurrentLength
strNumber = "0" & strNumber
Next i
End If
addZeros = "TL-" & strNumber
End Function
然后 运行 addZeros([你的字符串]) 转换为所需的格式。
(for user4888 in the comments of this question; 如何检查 'TL' 是否在字符串中的示例。这将检查单元格 A1 到 A10，并在相应的单元格中填充 1 或 0在 B 列中取决于单元格中是否有 'TL'）
Private Sub TLcheck()
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
For i = 1 To 10
ws.Cells(i, 2) = InStr(1, ws.Cells(i, 1), "TL")
Next i
End Sub
扩展 Orphid 的答案以包含 6 位数字：
Sub Test()
Dim str as string, ret as string, tmp as string, i as integer, j as integer
for j = 2 to StartSht.Range("C2").End(xlDown).Row
ret = ""
str = StartSht.Range("C" & j).Value
for i = 1 to len(str)
tmp = mid(str, i, 1)
if IsNumeric(tmp) then ret = ret + tmp
next i
For i = Len(ret) + 1 To 6
ret = "0" & ret
Next
ret = "TL-" & ret
StartSht.Range("C" & j).Value = ret
next j
End Sub
这是要在原来的B栏旁边写'ret'。您正在处理的 sheet 在运行时需要处于活动状态，因为如您所见，我没有指定要使用哪个 Sheet。如果有必要，你可以自己做。为此，我假设只需要对 1 个工作簿中的 1 个工作sheet 完成。如果我错了，请告诉我。
这是单行本。我正在抓取连字符前后的数据，修剪它们以删除空格，并添加连字符和额外的 0。
Sub splitAddZeros()
Dim sIn, sOut As String
sIn = "TL - 987"
out = Trim(Left(sIn, InStr(1, sIn, "-", vbTextCompare) - 1)) & "-" & Right("000000" & Trim(Right(sIn, Len(sIn) - InStr(1, sIn, "-", vbTextCompare))), 6)
Debug.Print out
End Sub
到目前为止你尝试了什么？您有任何代码可以向我们展示吗？
这应该是一个起点，您当然需要去掉空格并循环遍历整个文件。
Public Sub PaddingTest()
Dim PaddingArray() As String
Dim PaddingVar As String
PaddingArray() = Split(Range("A1").Value, "-", 2, vbTextCompare)
PaddingVar = PaddingArray(1)
While Len(PaddingVar) < 6
PaddingVar = "0" & PaddingVar
Wend
Range("A2").Value = PaddingArray(0) & "-" & PaddingVar
End Sub
msdn.microsoft.com 拆分命令的用法
有一种使用 excel 公式的方法：
="TL-" & TEXT(TRIM(RIGHT(A1,LEN(A1)-FIND("-",A1,1))),"000000")