[已解决]查找单括号中文字。.rar

水木

查找单括号中文字。.rar (8.14 KB, 下载次数: 5)

2016-11-4 10:12 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

爱疯

2016-11-4 11:29

Sub test()
    Dim i, x
    For i = 2 To 4
        x = Cells(i, "i")
        x = VBA.Replace(x, "〉", ">")
        Cells(i, "g") = tq(x)
    Next i
End Sub

Function tq(str)
    Dim matchs As Object, match As Object, d
    Set d = CreateObject("scripting.dictionary")
    d.RemoveAll
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = ".(?=>)"
        Set matchs = .Execute(str)
        For Each match In matchs
            d(match.Value) = ""
        Next
    End With
    tq = Join(d.keys, ",")
End Function

跳转到最佳答案楼层

爱疯

Sub test()
    Dim i, x
    For i = 2 To 4
        x = Cells(i, "i")
        x = VBA.Replace(x, "〉", ">")
        Cells(i, "g") = tq(x)
    Next i
End Sub

Function tq(str)
    Dim matchs As Object, match As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = ".(?=>)"
        Set matchs = .Execute(str)
        For Each match In matchs
            tq = tq & "," & match
        Next
    End With
    tq = Mid(tq, 2)
End Function

水木

爱疯 发表于 2016-11-4 10:45
Sub test()
    Dim i, x
    For i = 2 To 4

老师：您好！非常好，先谢谢！没想到另有一种情况，我当时没有考虑到，请谅解。再求助：问题是在查找的内容中，有重复的，请去重复。 查找单括号中文字。.rar (8.75 KB, 下载次数: 8)

2016-11-4 11:05 上传

点击文件名下载附件

爱疯

Sub test()
    Dim i, x
    For i = 2 To 4
        x = Cells(i, "i")
        x = VBA.Replace(x, "〉", ">")
        Cells(i, "g") = tq(x)
    Next i
End Sub

Function tq(str)
    Dim matchs As Object, match As Object, d
    Set d = CreateObject("scripting.dictionary")
    d.RemoveAll
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = ".(?=>)"
        Set matchs = .Execute(str)
        For Each match In matchs
            d(match.Value) = ""
        Next
    End With
    tq = Join(d.keys, ",")
End Function

雄鹰2013

Sub 提取() '2017.6.14
Dim regex As New RegExp
  Set d = CreateObject("scripting.dictionary")
Dim rng As Range
Dim m As IMatch2
With regex
      .Global = True
      .Pattern = "(?:<|〈)(.+)(?:>|〉)"
      For Each rng In Range("i2:i4")
          If .test(rng) Then
             Set ma = .Execute(rng)
             For Each m In ma
                 x = m.SubMatches(0)
                 d(x) = ""
             Next m
          End If
          rng.Offset(0, -1) = Join(d.keys, "、")
          d.RemoveAll
      Next rng
End With
End Sub