提取某字符串右侧汉字（查找统计）求源码大神帮忙

#2

xzlxzlxzl2014-06-16 10:40

好像不是特别难哦，假设01.txt在d盘根目录下，结果也存储到d盘根目录，新建一工程，窗体里放一个命令按钮，拷贝下述代码，运行后点击按钮即可完成任务。
Private Sub Command1_Click()
  Dim i As Integer, j As Integer, f As Long, a As String, b As String, d As String
  f = FreeFile
  Open "d:\01.txt" For Input As f
  b = ""
  While Not EOF(f)
    Line Input #f, a
    b = b & a
  Wend
  Close #f
  j = 1: d = "": f = 0
  Do
    i = InStr(j, b, "#BZ")
    j = i + 3
    If j < Len(b) And j > 3 Then
      a = Mid(b, j, 1)
      If InStr(d, a) = 0 Then d = d & "#BZ" & a & vbCrLf: f = f + 1
    End If
  Loop Until i = 0
  d = d & "共" & f & "个"
  f = FreeFile
  Open "d:\结果.txt" For Output As f
  Print #f, d
  Close #f
End Sub

#3

tzmhugh2014-06-16 19:40

谢谢啦

#4

czzgwz888882014-06-18 15:52

'首先加载Script Running类型库
Option Explicit
Dim fs As New FileSystemObject
Dim ts As TextStream

Private Sub Form_Load()
    Dim BZCount as long
    Dim LineText As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(App.Path & "\config.ini")

    BZCount=0
    Do While ts.AtEndOfStream = False
        LineText = ts.ReadLine

        Dim ThreeChar As String
        ThreeChar = Left(LineText, 3)
        If ThreeChar = "#BZ" Then
            BZCount = BZCount+1
        End If
    Loop
    ts.Close
    debug.print BZCount
End Sub

#5

tzmhugh2014-06-18 16:15

Private Sub Command1_Click()
CommonDialog1.ShowOpen
Text1 = CommonDialog1.FileName
End Sub

Private Sub Command2_Click()
Dim pStr() As String
Dim Str, s As String
Dim n As Long
Dim find
n = 0
find = Text2.Text 'BZ
Open Text1 For Input As #1
Do While Not EOF(1)
Line Input #1, s
pStr = Split(s, find)  '由于需要取以#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 & "\03.txt", find & Mid(pStr(i), 1, 1)) = True Then  '在02.txt中写入每一个有效的#U后面的第一个字，并且判断02.txt中是否已经存在相同的文本。
            n = n + 1
            End If
        End If
    End If
Next
Loop
Writetxt App.Path & "\03.txt", "共 " & n & " 个不同数据"
Close #1
End Sub

'***********下面是写入文本的子程序
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

好久没有用VB了现在都忘记了，这个应该是do while   loop循环？
我这样应该是不对的，
通过open读取txt，一行行读取，寻找关键字符（text2.text），提取关键字符 #BZ 后的汉子（主要判断是双字节就提取，排除标点比较麻烦），然后输出
大神！求救我只能做伸手党了 T.T

提取某字符串右侧汉字 （查找 统计） 求源码 大神帮忙