| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 537 人关注过本帖
标题:提取某字符串右侧汉字 (查找 统计) 求源码 大神帮忙
只看楼主 加入收藏
tzmhugh
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2014-6-15
结帖率:0
收藏
已结贴  问题点数:20 回复次数:4 
提取某字符串右侧汉字 (查找 统计) 求源码 大神帮忙
找出文件01.txt文件中,以#BZ开头的文字(如“#BZ三”、“#BZ溙”等,#BZ后是任意汉字)。
统计这个文件中有多少不同类型(不重复)的#BZ开头文字,并把结果保存到当前目录的“结果.txt”。

提示:xml文件可以作为文本文件打开查找,“结果.txt”是如下形式:
#BZ三
#BZ溙
.
.
.
#BZ犃
共83个
搜索更多相关主题的帖子: 文本文件 字符串 汉字 统计 
2014-06-15 19:48
xzlxzlxzl
Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15
来 自:湖北
等 级:贵宾
威 望:125
帖 子:1091
专家分:5825
注 册:2014-5-3
收藏
得分:10 
好像不是特别难哦,假设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
2014-06-16 10:40
tzmhugh
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2014-6-15
收藏
得分:0 
谢谢啦
2014-06-16 19:40
czzgwz88888
Rank: 2
等 级:论坛游民
帖 子:22
专家分:55
注 册:2006-3-25
收藏
得分:10 
'首先加载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
2014-06-18 15:52
tzmhugh
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2014-6-15
收藏
得分:0 
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
2014-06-18 16:15
快速回复:提取某字符串右侧汉字 (查找 统计) 求源码 大神帮忙
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.038956 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved