String 从EXCEL VBA中的随机字符串中提取特定的数字集

免责声明-我的案例是特定的，在我的案例中，我的代码是有效的，因为我知道模式

我到处都在寻找答案，而我尝试的代码并不完全是我想要的，如果您正在寻找一组数字，这是我的解决方案。
在我的例子中，我在寻找7位数字，从带有随机字符串的a列中的数字

1

开始，一些字符串有数字，而另一些没有

该数字将出现在这三个场景“1XXXXXX”、“pxxxxxxx”、“PXXXXXXXXX”（由于有斜杠，所以数字更多）

以下是字符串的示例：

9797 P/O1743061 465347  Hermann Schatte Earl Lowe          
9797 Po 1743071 404440  Claude Gaudette Jose Luis Lopez     
9817 1822037    463889  Jean Caron  Mickelly Blaise 

我的代码

Sub-getnum（）
我不使用显式，所以我没有声明所有内容
像线一样暗的线
作为整数的Dim i
Dim arra（）作为字符串
Dim arran（）作为字符串
Orig.AutoFilterMode=False
呼叫BeginMacro
LastRow=原始单元格（Rows.Count，1）.End（xlUp）.Row
原始范围（“J2:J”和最后一行）。清除
'循环通过列
对于n=2到最后一行
celref=原始单元格（n，4）.值
'在空白处拆分字符串
arra（）=拆分（celref，“”）
'将字符串转换为多个字符串
对于计数器=LBound（arra）到UBound（arra）
strin=arra（计数器）
'从字符串中删除空格
存储=修剪（strin）
lenof=Len（存储）
'如果字符串有9个字符，请检查条件
如果lenof=9，则
'第一个和最后一个字符的位置
somstr=Mid（存储，1，1）
somot=Mid（存储，9，1）
如果somstr=“P”或somstr=“P”和IsNumeric（somot）=True，则
'删除采购订单或采购订单，仅保留7位数字
存储=右侧（存储，7）
'存储在第J列中
原始单元格（n，10）。值=存储
如果结束
ElseIf lenof=10那么
somstr=Mid（存储，1，1）
somot=Mid（存储，10，1）
"其他条件,
如果somstr=“P”或somstr=“P”和IsNumeric（somot）=True，则
'删除采购订单或采购订单，仅保留7位数字
存储=右侧（存储，7）
'存储在第J列中
原始单元格（n，10）。值=存储
如果结束
如果结束
'删除其中的逗号
arran（）=拆分（存储，“，”）
如果原始单元格（n，10）。值存储
对于计数器2=LBound（arran）到UBound（arran）
strin2=arran（计数器2）
存储2=修剪（strin2）
'最终条件if为7位，以1开头
如果IsNumeric（storage2）=True且Len（storage2）=7，则
car=Mid（存储2、1、1）
如果car=1，则
'存储在特定位置的J列中
原始单元格（n，10）。值=存储2
如果结束
其他的
如果为数字（原始单元格（n，10）.value）=真且
len（原始单元格（n，10）。然后值=7
原始单元格（n，10）.value=原始单元格（n，10）.value
其他的
原始单元格（n，10）.Value=“D中无订单”
如果结束
下一个柜台2
如果结束
下一个柜台
下一个
调用EndMacro
端接头

您可以使用正则表达式以所需格式提取数字

请试试这个

Function Get10DigitNumber(ByVal Str As String) As String    
Dim RE As Object
Set RE = CreateObject("VBScript.RegExp")
With RE
   .Global = False
   .Pattern = "1\d{6}"
End With
If RE.test(Str) Then
    Get10DigitNumber = RE.Execute(Str)(0)
End If
End Function

如果你想在工作表上使用这个函数，假设你的字符串是A2，试试这个

=Get10DigitNumber(A2)

或

您可以在另一个子例程/宏中使用此函数，如下所示

Debug.Print Get10DigitNumber(<pass your string variable here>)

如上文所述，使用if。

您可以试试这个

Option Explicit
Sub getnum()
    Dim position As Variant
    Dim cell As Range
    With  Worksheets("Orig") ' change it to your actual sheet name
        With Intersect(.UsedRange, Columns("J"))
            .Replace what:="P/O", replacement:="P/O ", lookat:=xlPart
            For Each cell In .Cells
                position = InStr(cell.Text, " 1")
                If position > 0 Then cell.Value = Mid(cell.Value, position + 1, 7)
            Next
        End With
    End With    
End Sub

---

此代码粘贴两个公式（一个在G列，一个在J列）。第一个公式检查第2列单元格的第一个字符中是否有“P”，如果有“P”，则提取字符串中的最后7个字符，并将其放入第G列。第二个公式检查是否有nota“P”，如果没有，则提取字符串中的最后7个字符，并将其放入第J列

Sub Extract()
Dim ws As Worksheet
Dim lRow As Long

Set ws = ThisWorkbook.Sheets("Sheet3")
lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

     ws.Range("G2:G" & lRow).Formula = "=IF(LEFT(B2)=""P"",(RIGHT(B2,7)),"""")"
     ws.Range("J2:J" & lRow).Formula = "=IF(LEFT(B2)<>""P"",(RIGHT(B2, 7)),"""")"

End Sub

Sub-Extract（）
将ws设置为工作表
暗淡的光线和长的一样
设置ws=ThisWorkbook.Sheets（“Sheet3”）
lRow=ws.Cells（ws.Rows.Count，“A”）.End（xlUp）.Row
ws.Range（“G2:G”和lRow）.Formula=“=IF（左（B2）=“P”（右（B2,7）），”
ws.Range（“J2:J”和lRow.Formula=“=IF（左（B2）“P”（右（B2，7）），“”）
端接头

在理解了您所做的工作之后，我认为这将起作用。如有任何反馈，将不胜感激

Dim cell As Range, LRow As Long
LRow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row

    For Each cell In Range("D2:D" & LRow)
        If cell.Value Like "*Po *" Then
            cell.Offset(0, 6).Value = Split(cell.Value, " ")(2)

        Else: cell.Offset(0, 6).Value = Split(cell.Value, " ")(1)

        End If
    Next cell

    For Each cell In Range("J2:J" & LRow)
        If Len(cell.Value) > 7 Then
            cell.Value = Right(cell.Value, 7)
        End If
    Next

---

请看。您可以使用

RegEx

object，查找7位

Pattern=“\d{7}”

Regexp需要引用外部lib，这会让您心碎，而且速度非常慢。在真实的DB witj上，你会喜欢数十万条记录：）@MarY我说的三种场景模式都有领先空间，对吗？可能是Chr（160）还是不是？@user6698332在这个特定的例子中，我不需要PO或PO，通过单独隔离“p”或“p”，我得到了所有的例子，我不会写我不需要的东西……最后，代码工作了，我使用了它，得到了我需要的所有数字。但这是非常具体的。如果您使用它，您需要检查字符串中的限制。@MarY，有什么反馈吗？我试过了，但不起作用……它只完成了一半的工作，它检索7位数字，但检索带有破折号的7位数字的字符串，它忽略了PXXXXXXX，从您的代码中可以明显看出，它忽略了这一点。此外，但只是一个细节，我需要将数字传输到另一列，在我的代码中，我取D列中的数字并在J列中显示结果。这是您的代码给出的结果类型060-428 0-B0391，01-2018，060-428 01-2018 0-B0478，03-2018，所以nope根本不起作用！甚至没有一部分。此外，您不能在vba中使用1Row，因为数字的原因，在公式中使用1Row时会混淆。对不起，我以为您的示例在多个单元格中。它是“lRow”而不是“1Row”。这几乎是完美的，它只需要一个wo

Sub Extract()
Dim ws As Worksheet
Dim lRow As Long

Set ws = ThisWorkbook.Sheets("Sheet3")
lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

     ws.Range("G2:G" & lRow).Formula = "=IF(LEFT(B2)=""P"",(RIGHT(B2,7)),"""")"
     ws.Range("J2:J" & lRow).Formula = "=IF(LEFT(B2)<>""P"",(RIGHT(B2, 7)),"""")"

End Sub

Dim cell As Range, LRow As Long
LRow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row

    For Each cell In Range("D2:D" & LRow)
        If cell.Value Like "*Po *" Then
            cell.Offset(0, 6).Value = Split(cell.Value, " ")(2)

        Else: cell.Offset(0, 6).Value = Split(cell.Value, " ")(1)

        End If
    Next cell

    For Each cell In Range("J2:J" & LRow)
        If Len(cell.Value) > 7 Then
            cell.Value = Right(cell.Value, 7)
        End If
    Next