[已解决]从长字符串中提取特定字符

shawxxy

各位大侠，你们好：
    想从长字符串中提取特定的字符。如b2格中有内容“1号仓库：高兴路18号，（P534644），数量：1。2号仓库：高兴路东32号，（P534645），数量：1。3号仓库：平安路1号附1号，（P534646），数量：1。“，想生成c2格”1号“，d2格”P534644“，c3格”2号“，d3格”P534645“，以此类推。具体见附件。

最佳答案

月排行榜 / 总排行榜

JLxiangwei

2013-5-11 16:35

都没有人做呢
'======================================
Sub 提取()
    Dim regex As Object
    Dim arr, arr1(1 To 10000, 1 To 2), x, k, matches, match, k1
    arr = Range("a1").CurrentRegion
    With CreateObject("VBSCRIPT.REGEXP")
        .Global = True
        .Pattern = "P\d{6}"
        For x = 2 To UBound(arr)
            Set matches = .Execute(arr(x, 2))
            k1 = 0
            For Each match In matches
            k = k + 1
            k1 = k1 + 1
            arr1(k, 1) = arr(x, 1) & "-" & k1
            arr1(k, 2) = match
            Next
        Next
    End With
    Range("d:e").ClearContents
    Range("d:d").NumberFormat = "@"
    Range("d2").Resize(k, 2) = arr1
End Sub
'============================================
求助.rar (12.22 KB, 下载次数: 551)

2013-5-11 16:35 上传

点击文件名下载附件

跳转到最佳答案楼层

1032446692

你一个单元格有多少数据啊？

shawxxy

我的b2单元格中是导入的文本，字符有长有短，多的有200多个汉字。

JLxiangwei

都没有人做呢
'======================================
Sub 提取()
    Dim regex As Object
    Dim arr, arr1(1 To 10000, 1 To 2), x, k, matches, match, k1
    arr = Range("a1").CurrentRegion
    With CreateObject("VBSCRIPT.REGEXP")
        .Global = True
        .Pattern = "P\d{6}"
        For x = 2 To UBound(arr)
            Set matches = .Execute(arr(x, 2))
            k1 = 0
            For Each match In matches
            k = k + 1
            k1 = k1 + 1
            arr1(k, 1) = arr(x, 1) & "-" & k1
            arr1(k, 2) = match
            Next
        Next
    End With
    Range("d:e").ClearContents
    Range("d:d").NumberFormat = "@"
    Range("d2").Resize(k, 2) = arr1
End Sub
'============================================
求助.rar (12.22 KB, 下载次数: 551)

2013-5-11 16:35 上传

点击文件名下载附件

shawxxy

谢谢啦，已解决了，感谢JLxiangwe大侠！i