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

Question

免责声明-我的情况是具体的，在我的情况下，我的代码有效，因为我知道模式。

我到处都在寻找答案，但我尝试的代码并不完全符合我的要求，如果您正在寻找一组数字，这就是我的解决方案。
就我而言，我正在寻找 7 位数字，从数字 1 开始，在一个带有随机字符串的列中，一些字符串具有其他一些没有的数字。

数字会出现在“1XXXXXX”、“PXXXXXXXX”、“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()

'i don't use explicit so i didn't declare everything
Dim stlen As String
Dim i As Integer
Dim arra() As String
Dim arran() As String

Orig.AutoFilterMode = False
Call BeginMacro

LastRow = Orig.Cells(Rows.Count, 1).End(xlUp).Row
Orig.Range("J2:J" & LastRow).Clear

'loop though column
For n = 2 To LastRow
    celref = Orig.Cells(n, 4).Value
    'split string on white spaces
    arra() = Split(celref, " ")
    'turn string to multiple strings
    For counter = LBound(arra) To UBound(arra)
        strin = arra(counter)

        'remove white spaces from string
        storage = Trim(strin)
        lenof = Len(storage)

        'if string has 9 characthers, check for conditions
        If lenof = 9 Then
            'position of first and last charachter
            somstr = Mid(storage, 1, 1)
            somot = Mid(storage, 9, 1) 

            If somstr = "P" Or somstr = "p" And IsNumeric(somot) = True Then
                'removes Po or PO and keeps only 7 digits
                storage = Right(storage, 7)
                'stores in column J
                Orig.Cells(n, 10).Value = storage
            End If

        ElseIf lenof = 10 Then
            somstr = Mid(storage, 1, 1)
            somot = Mid(storage, 10, 1)

            'other conditions
            If somstr = "P" Or somstr = "p" And IsNumeric(somot) = True Then
                'removes Po or PO and keeps only 7 digits
                storage = Right(storage, 7)
                'stores in column J
                Orig.Cells(n, 10).Value = storage
            End If
        End If

        'eliminate comma within
        arran() = Split(storage, ",")

        If Orig.Cells(n, 10).Value <> storage Then
            For counter2 = LBound(arran) To UBound(arran)
                strin2 = arran(counter2)
                storage2 = Trim(strin2)

                'final condition if is 7 digits and starts with 1
                If IsNumeric(storage2) = True And Len(storage2) = 7 Then
                    car = Mid(storage2, 1, 1)

                    If car = 1 Then
                        'stores in columns J at specific position
                        Orig.Cells(n, 10).Value = storage2
                    End If
                Else
         If isnumeric(orig.cells(n,10).value) =true and _ 
             len(orig.cells(n,10).value = 7 then
                        orig.cells(n,10).value = orig.cells(n,10).value 
                        else
                    Orig.Cells(n, 10).Value = "no po# in D"
                End If
            Next counter2
        End If
    Next counter
Next n

Call EndMacro

End Sub

Answer 1

您可以使用 RegEx 以所需格式提取数字。

请试一试...

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>)

编辑功能：

Function Get10DigitNumber(ByVal Str As String) As String
Dim RE As Object, Matches As Object
Set RE = CreateObject("VBScript.RegExp")
With RE
   .Global = False
   .Pattern = "[Pp]?\/?[Oo]?(1\d{6})\b"
End With
If RE.test(Str) Then
    Set Matches = RE.Execute(Str)
    Get10DigitNumber = Matches(0).SubMatches(0)
End If
End Function

并使用 if 如上所述。

Answer 2

你可以试试这个

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

Answer 3

此代码粘贴两个公式，一个在 G 列中，一个在 J 列中）。第一个公式检查第 2 列单元格的第一个字符中是否有“P”，如果有“P”，它会提取字符串中的最后 7 个字符并将它们放在 G 列中。第二个公式检查是否有不是“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

Answer 4

在了解您在做什么之后，我认为这会起作用。任何反馈将不胜感激。

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