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)

OR

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

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

并使用如上所述。

Answer 2

你可以试试这个

movieName

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

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

4 个答案: