|
- Sub d()
- Dim Reg As Object, Mac As Object, Dic As Object, M As Object, arr(), str As String
- Set Reg = CreateObject("VBScript.RegExp"): Set Dic = CreateObject("Scripting.Dictionary"): str = "^([一-龥]+).+(" & Sheet1.[B2] & ")"
- arr = Sheet1.Range("b4").CurrentRegion: Reg.Global = 1: Reg.Pattern = str: Reg.MultiLine = 1
- Set Mac = Reg.Execute(Sheet1.[A2])
- For Each M In Mac
- r = r + 1: c = 0
- For Each ii In M.SubMatches
- c = c + 1
- If c = 1 Then Dic(ii) = ""
- Next
- Next
- For i = 2 To UBound(arr)
- If Dic.Exists(arr(i, 1)) Then
- arr(i, 2) = "是"
- Else
- arr(i, 2) = "否"
- End If
- Next
- Range("c5").Resize(65500, 1).ClearContents: Range("b4").CurrentRegion = arr
- End Sub
复制代码 |
|