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

时间:2018-03-24 17:06:21

标签: excel string vba excel-vba digits

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

我到处寻找答案,我尝试的代码并不是我想要的,如果你正在寻找一组数字,这是我的解决方案。
在我的情况下,我正在寻找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

4 个答案:

答案 0 :(得分:0)

您可以使用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

并使用如上所述。

答案 1 :(得分:0)

你可以试试这个

movieName

答案 2 :(得分:0)

此代码在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

答案 3 :(得分:0)

在了解了你在做什么之后,我认为这会奏效。任何反馈都将不胜感激。

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