正则分类统计

Dim d As Object
Sub main()
    Set d = CreateObject("scripting.dictionary")
    With Sheet1
        .Range("c1").CurrentRegion = ""
        ar = .Range("a1").CurrentRegion
        For x = 1 To UBound(ar)
            s = ar(x, 1)
            If InStr(s, "，") > 0 Then s = Replace(s, "，", ",")
            sp = Split(s, ",")
            For i = 2 To UBound(sp)
                ar_res = split_by_rege(sp(i))
                If Not d.exists(ar_res(0)) Then
                    d(ar_res(0)) = ar_res(1)
                Else
                    k = d(ar_res(0))
                    k = k & "," & ar_res(1)
                    d(ar_res(0)) = k
                End If
            Next
        Next
        r = 1
        .Range("c1").Resize(1, 3) = Array("品种", "数量", "备注")
        For Each a In d.keys
            r = r + 1
            .Cells(r, 3) = a
            .Cells(r, 4) = second_split(d(a))
            If InStr(a, "鱼") > 0 Then .Cells(r, 5) = Replace(d(a), ",", "+")
        Next
        .Range("c1").CurrentRegion.Borders.LineStyle = 0
        .Range("c1").CurrentRegion.Borders.LineStyle = 1
        .Cells.Interior.ColorIndex = 0
        For j = 1 To r
            If j Mod 2 = 1 Then .Range(Cells(j, 3), Cells(j, 5)).Interior.ColorIndex = 34
        Next
    End With
    Set d = Nothing
End Sub

Function second_split(s)
    If InStr(s, ",") > 0 Then
        spl = Split(s, ",")
        For x = 0 To UBound(spl)
            tem_res = split_by_rege3(spl(x))
            tem = tem + tem_res(0) * 1
        Next
        second_split = tem & tem_res(1)
    Else
        second_split = s
    End If
End Function

Function split_by_rege2(s)
    With CreateObject("vbscript.regexp")
        .Pattern = "(\d*\.?\d*)([一-龥]+)"
        .Global = True
        .IgnoreCase = True
        .MultiLine = False
        Set mh = .Execute(s)
        s1 = mh(0).SubMatches(0)
        s2 = Replace(s, s1, "")
    End With
    split_by_rege2 = Array(s1, s2)
End Function

Function split_by_rege3(s)
    With CreateObject("vbscript.regexp")
        .Pattern = "(\d*\.?\d*)([一-龥]+)"
        .Global = True
        .IgnoreCase = True
        .MultiLine = False
        Set ma = .Execute(s)
        s1 = ma(0).SubMatches(0)
        s2 = ma(0).SubMatches(1)
    End With
    split_by_rege3 = Array(s1, s2)
End Function

Function split_by_rege(s)
    With CreateObject("vbscript.regexp")
        .Pattern = "([一-龥]+)|(\d*\.?\d*(斤|条))"
        .Global = True
        .IgnoreCase = True
        .MultiLine = False
        Set mh = .Execute(s)
        s1 = mh(0).SubMatches(0)
        s2 = mh(1).SubMatches(1)
    End With
    split_by_rege = Array(s1, s2)
End Function