VB 文本提取某指定字符右边的汉字

先分割字符串
Dim pStr() As String
Dim Str As String
Dim n As Long
n = 0
Str ="#U内蒙古自治区#U#U锡林郭勒盟#U北部。旗人民政府驻#U新浩特镇#U。#U明#U蒙古族#U塔尔尼库同#U率部在此驻牧，称其部为#U阿巴嘎#U。#U清#U初分设#U西阿巴嘎#U、#U西阿巴哈纳尔#U、#U东阿巴嘎#U、#U东阿巴哈纳尔#U四旗。1950年#U西阿巴嘎#U、#U西阿巴哈纳尔#U两旗合并为#U西阿巴嘎西阿巴哈纳尔联合旗#U，#U东阿巴嘎#U、#U东阿巴哈纳尔#U和#U西浩济特旗#U合并为#U东阿巴嘎东阿巴哈纳尔西浩济特联合旗#U。1952年两联合旗并为#U西部联合旗#U，1956年改#U阿巴嘎旗#U。草原广阔。经济以畜牧业为主，产牛、马、绵羊、山羊等。矿产有铁、锰等。工业有采矿、建筑、缝纫、食品加工。名胜古迹有#U宝格都山#U、#U海日罕山#U、杨都庙。"
pStr = Split(Str,"#U")
'由于需要取以#u开头的文字,pStr(0)是以#U前面的，所以舍去
'然后判断每一段文字是否为空，是否为标点(以为上面的文字段落不是很标准，有两个#U之间是'标点的情况，也有两个#U连在一起的情况)
For i = 1 To Ubound(pStr)
If pStr(i) <> "" Then '判断#U和#U是否相连的，之间是否为空
If InStr("，。、,.",pStr(i)) = 0 Then '判断#U和#U之间是否仅有一个标点
If Writetxt (App.Path & "\02.txt","#U" & Mid(pStr(i),1，1)) = True Then ’ 在02.txt中写入每一个有效的#U后面的第一个字，并且判断02.txt中是否已经存在相同的文本。
n = n + 1
EndIf
End If
End If
Next
Writetxt App.Path & "\02.txt","共 " & n & " 个不同数据"

'***********下面是写入文本的子程序

Private Function Writetxt(tPath As String, txt As String) As Boolean
Dim s2 As String
Writetxt = False
On Error Resume Next
If Dir(tPath) <> "" Then
Open tPath For Input As #1
Else
Open tPath For Output As #1
End If
Do While Not EOF(1)
Line Input #1, s2
If txt = s2 Then Close #1: Exit Function '如果txt文件中已存在一行同样的字符串，则不写入，退出写入程序
Loop
Close #1
Open tPath For Append As #1
Print #1, txt
Writetxt = True
Close #1
End Function