客户代码
6.00-9C26010AC红富士苹果
23*9-10S75214AC红富士苹果
8.15-15/28*9-10C80118AC红富士苹果
8.15-15/28*9-10C8900ACC红富士苹果

http://s14/mw690/001f8HsBgy6I7lu0XGl2d&690


Sub 正则分组匹配提取()
    Dim Arr, brr, i As Long, Mat As Object, st As String
    Arr = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
    ReDim brr(1 To UBound(Arr), 1 To 4)
    With CreateObject("Vbscript.RegExp")
        .ignorecase = False
        For i = 1 To UBound(Arr)
            If Len(Arr(i, 1)) > 20 Then
                st = "(^.*?)([A-Z]\d{4})(\d?[A-Z]+)(.*$)"
            Else
                st = "(^.*?)([A-Z]\d{3})(\d{2}[A-Z]+)(.*$)"
            End If
            .Pattern = st
            Set Mat = .Execute(Arr(i, 1))(0)
            brr(i, 1) = Mat.submatches(0)
            brr(i, 2) = Mat.submatches(1)
            brr(i, 3) = Mat.submatches(2)
            brr(i, 4) = Mat.submatches(3)
            Set Mat = Nothing
        Next i
    End With
    Sheet1.Range("B2:E" & Rows.Count).ClearContents
    Sheet1.Range("B2").Resize(i - 1, 4) = brr
End Sub