| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 3575 人关注过本帖
标题:求个VB思路
只看楼主 加入收藏
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
结帖率:89.13%
收藏
 问题点数:0 回复次数:15 
求个VB思路
需要在文本中所有的汉字后加上一个空格,如何解决。文本有二万多行。
给个编程思路就行。
图片附件: 游客没有浏览图片的权限,请 登录注册
搜索更多相关主题的帖子: 编程 思路 多行 文本 VB 
2021-07-26 15:32
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
按顺序打开文件,同时打开一个临时文件用来写文件。
一行一行的读,
可以有预处理:把TAB值替换为一个空格,把二个空格替换为一个空格。
循环截取每个字符,使用 mid 函数截取,
然后判断,ASCII码值,大于0的为字母或空格,其他就算汉字。
然后这里你的要求没看懂,如 戒严 是1、在 戒 严 每个字后面加个空格,还是 2、在这个词后面加空格。
1的话,发现是中文字(非字母),就加一个空格进去。
2的话,发现是中文字(非字母),设标志,再继续循环,直到发现字母时,加一个空格进去。
拼好的字符串,按行写入临时文件。





授人于鱼,不如授人于渔
早已停用QQ了
2021-07-26 19:13
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:0 
已搞定,搞定之后才发现你上面发的内容。

思路:
1.全部转换为ASCII,用逗号分开
2.ASCII打散成数组,ASCII依次还原为字符,加条件加空格

VBS代码如下:
程序代码:
Dim i, str, ascstr,l
Const ForReading = 1, ForWriting = 2,ForAppend=8
Dim fso, f,openFile
Set fso = CreateObject("Scripting.FileSystemObject")

Set Stm =CreateObject("ADODB.Stream")
Stm.Type=2 '2-文本模式,1-二进制模式
Stm.Mode=3 '3-读写,1-读,2-写
Stm.CharSet= "gb2312" 'Unicode,utf-8,ASCII,gb2312,big5,gbk
Stm.Open
Stm.LoadFromFile "1.txt"
str = Stm.ReadText
Stm.Close
Set Stm=Nothing

For i = 1 To Len(str)
ascstr = ascstr & "," & CStr(Asc(Mid(str, i, 1)))
j = right(ascstr,len(ascstr)-1)
Next
'MsgBox j
Set f = fso.OpenTextFile("ASCII代码.txt",ForAppend, True)
f.Write j
f.Close


Set openFile=fso.OpenTextFile("ASCII代码.txt",1,True)    '1表示只读,2表示可写,8表示追加,True表示目标文件存在时是否覆盖
AsciiStr = openFile.ReadAll
openFile.Close

S=split(AsciiStr,",")  '以空格作为分隔符
For i=0 to ubound(S)
if i+1 <= ubound(S) then  '防止下标越界
if S(i)<0 and S(i+1)>=0 then  '加入空格的时机,条件
SaveFiles(Chr(S(i)))
SaveFiles(" ")
else
SaveFiles(Chr(S(i)))
end if
else
SaveFiles(Chr(S(i)))
end if
Next

Function SaveFiles(content)  '文件内容
   Const ForReading = 1, ForWriting = 2,ForAppend=8
   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile("已处理文本.txt",ForAppend, True)
   f.Write content
End Function

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2021-07-26 19:40
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
Set Stm =CreateObject("ADODB.Stream")
Stm.Type=2 '2-文本模式,1-二进制模式
Stm.Mode=3 '3-读写,1-读,2-写
Stm.CharSet= "gb2312" 'Unicode,utf-8,ASCII,gb2312,big5,gbk
Stm.Open
Stm.LoadFromFile "1.txt"
str = Stm.ReadText
Stm.Close
Set Stm=Nothing
使用 ADODB.Stream 打开文件,读了全部内容就关闭。这里容易产生的BUG就是文件如果过大,会导致内存爆掉。
------------------
For i = 1 To Len(str)
ascstr = ascstr & "," & CStr(Asc(Mid(str, i, 1)))
j = right(ascstr,len(ascstr)-1)
Next
'MsgBox j
Set f = fso.OpenTextFile("ASCII代码.txt",ForAppend, True)
f.Write j
f.Close
预处理读到的内容,然后保存到一个文件,等等,为什么这步要保存?? 这里保存文件使用的是 FSO 。另外是追加模式,如果第一次运行时生成的文件没删掉时,再运行第二次那文件里会有第二份内容啊。

Set openFile=fso.OpenTextFile("ASCII代码.txt",1,True)    '1表示只读,2表示可写,8表示追加,True表示目标文件存在时是否覆盖
AsciiStr = openFile.ReadAll
openFile.Close
重新读上一行保存的文件。等等,为什么这步要重新读,不可以直接用上步生成的字符串吗?
还有,这里读取使用的是 FSO ,为什么不用第一步的  ADODB.Stream  ,兼程序不够复杂吗?
到这步,内存里已存在 三份副本。
1、原始文件:str
2、预处理后的内容:j
3、重新读取后的内容:Asciistr

----------------
S=split(AsciiStr,",")  '以空格作为分隔符
For i=0 to ubound(S)
if i+1 <= ubound(S) then  '防止下标越界
if S(i)<0 and S(i+1)>=0 then  '加入空格的时机,条件
SaveFiles(Chr(S(i)))
SaveFiles(" ")
else
SaveFiles(Chr(S(i)))
end if
else
SaveFiles(Chr(S(i)))
end if
Next
处理,然后每处理一个字符,就直接写入文件。
每次写一个字符时,就会触发一次写盘操作,极大的影响效率和磁盘的寿命,如果是 固态硬盘的话,按你文件字符数进行磨损块次数。

为什么不直接在上一次直接得到ascii数组
只需要几句代码

程序代码:
redim S(len(str)           '重定义数组大小
For i = 1 To Len(str)
    s(i)=Asc(Mid(str, i, 1))      '保存ASCII码
Next

=====================
总结:
1、程序是拼凑起来的。不同部分甚至使用了不同的组件。
2、对程序的优化没任何经验。程序优化有二个方向,内存优化和速度优化。
   对于处理文件不能确定大小时,有可能出现超大文件时,考虑的是内存优化,这种情况下是读文件的部分容进行进行处理的。  
   对于处理文件能确定不会超大时,这时考虑的是速度优化,文件就是一次性读入内容。
   根据你的代码能正常运行,说明你文件不会超大,可以使用速度优化,按行处理好了,为啥硬要分解成每一个字符来处理呢,拖延运行速度。



[此贴子已经被作者于2021-7-27 13:41编辑过]


授人于鱼,不如授人于渔
早已停用QQ了
2021-07-27 13:00
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
程序代码:
'这二个文件名我测试用的
Const FileName1 = "D:\86_1.txt"             '原始文件名
Const FileName2 = "D:\86_2.txt"             '目标文件名

Dim s1 As String
Dim f() As String
Dim i As Long, j As Long                    '两个循环变量
Dim k1 As Integer, k2 As Integer            '两个AscII值临时变量

'-------读所有内容---------
Open FileName1 For Binary Access Read As #1
    s1 = StrConv(InputB$(LOF(1), 1), vbUnicode)
Close #1

'--------按行分解--------
f = Split(s1, vbCrLf)
s1 = ""                                     '释放字符串内存

'--------直接处理,无预处理--------
For i = 0 To UBound(f)
    If Len(f(i)) > 0 Then                   '空行直接跳
        k1 = Asc(Left(f(i), 1))             '第一个字符的Asc值
        For j = 1 To Len(f(i)) - 1          '循环取所有的字符
            k2 = Asc(Mid(f(i), j + 1, 1))   '后面一个字符的值,k1前一个的值
            
            If k1 < 0 And k2 > 0 Then       '判断
                If k2 <> 32 Then            '如果k2不为空格,则加上空格。是空格的不再加上空格
                    f(i) = Left(f(i), j) & " " & Mid(f(i), j + 1)   '在字符串中间插入一个空格
                    Exit For                '一行只加一个空格,处理完本行结束
                End If
            End If
            k1 = k2                         '如果不符合条件,把后一个字符值给k1,按循环,k2将又是后一个字符
        Next j
    End If
Next i

s1 = Join(f, vbCrLf)                        '拼接字符串,分隔符仍然是回车换行符
 
Erase f                                     '释放数组内存
 
Open FileName2 For Binary Access Write As #1
    Put #1, 1, s1                           '一次性写入文件
Close #1


授人于鱼,不如授人于渔
早已停用QQ了
2021-07-27 13:36
diycai
Rank: 8Rank: 8
等 级:贵宾
威 望:19
帖 子:147
专家分:895
注 册:2021-5-18
收藏
得分:0 
那么请问如何区分 ANSI UTF8 Unicode编码的汉字? 比如UTF8有3字节、4字节的汉字,并且编码的字节里有小于0的,也有大于0的。
2021-07-27 13:58
William1949
Rank: 3Rank: 3
等 级:新手上路
威 望:8
帖 子:111
专家分:0
注 册:2009-3-17
收藏
得分:0 
用正则 试试

程序代码:
Private Sub Command1_Click()
    Dim Source  As String, Dest      As String
    Dim RE      As New RegExp
    Dim MColl   As MatchCollection
    
    Source = "工a aaaa" & vbCrLf & "式aa aad" & vbCrLf & "黄花菜aaae"
    
    With RE
        .Global = True
'        .Pattern = "([\u4e00-\u9fa5])(\w)"     '匹配 汉字与非汉字
        .Pattern = "([\u4e00-\u9fa5])"          '匹配 每个汉字
        
        Set MColl = .Execute(Source)
        
'        Dest = .Replace(Source, "$1 $2")   '汉字与非汉字之间,加空格
        Dest = .Replace(Source, "$1 ")      '每个汉字之间,加空格
    End With
    
    Set RE = Nothing
End Sub


图片附件: 游客没有浏览图片的权限,请 登录注册
2021-07-29 21:55
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:0 
回复 5楼 风吹过b
算了,就这样了。

程序代码:
Const ForReading = 1, ForWriting = 2,ForAppend=8
Set fso = CreateObject("Scripting.FileSystemObject")
Set openFile=fso.OpenTextFile("1.txt",1,True)  
str = openFile.ReadAll
'MsgBox str
openFile.Close

For i = 1 To Len(str)
ascstr = ascstr & "," & CStr(Asc(Mid(str, i, 1)))
j = right(ascstr,len(ascstr)-1)
Next
'MsgBox j
Set f = fso.OpenTextFile("ASCII代码.txt",2, True)
f.Write j
f.Close


Set openFile=fso.OpenTextFile("ASCII代码.txt",1,True)  
AsciiStr = openFile.ReadAll
openFile.Close

S=split(AsciiStr,",")  '以空格作为分隔符
For i=0 to ubound(S)
if i+1 <= ubound(S) then  '防止下标越界
if S(i)<0 and S(i+1)>=0 then  '加入空格的时机,条件
SaveFiles(Chr(S(i)))
SaveFiles(" ")
else
SaveFiles(Chr(S(i)))
end if
else
SaveFiles(Chr(S(i)))
end if
Next

Function SaveFiles(content)  '文件内容
   Const ForReading = 1, ForWriting = 2,ForAppend=8
   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile("已处理文本.txt",ForAppend, True)
   f.Write content
End Function

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2021-08-08 20:50
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:0 
以下是引用William1949在2021-7-29 21:55:22的发言:

用正则 试试


Private Sub Command1_Click()
    Dim Source  As String, Dest      As String
    Dim RE      As New RegExp
    Dim MColl   As MatchCollection
   
    Source = "工a aaaa" & vbCrLf & "式aa aad" & vbCrLf & "黄花菜aaae"
   
    With RE
        .Global = True
'        .Pattern = "([\u4e00-\u9fa5])(\w)"     '匹配 汉字与非汉字
        .Pattern = "([\u4e00-\u9fa5])"          '匹配 每个汉字
        
        Set MColl = .Execute(Source)
        
'        Dest = .Replace(Source, "$1 $2")   '汉字与非汉字之间,加空格
        Dest = .Replace(Source, "$1 ")      '每个汉字之间,加空格
    End With
   
    Set RE = Nothing
End Sub


代码有Bug,汉字与非汉字之间,加空格 这一句

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2021-08-08 21:11
kings12333
Rank: 2
等 级:论坛游民
帖 子:114
专家分:66
注 册:2012-11-29
收藏
得分:0 
回复 5楼 风吹过b
版主,这种代码格式是什么软件生成的,还是自己手敲出来刻意弄成这样的格式的……像For ....nxt,IF语句
2021-08-09 16:14
快速回复:求个VB思路
数据加载中...
 
   



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

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