求个VB思路 - VB6论坛

楼主

问题点数：0 回复次数：3

求个VB思路

需要在文本中所有的汉字后加上一个空格，如何解决。文本有二万多行。
给个编程思路就行。

图片附件: 游客没有浏览图片的权限，请登录或注册

搜索更多相关主题的帖子: 编程　思路　多行　文本　 VB　

第 2 楼

得分: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.为防伸手党，本站已停止会员注册。

第 3 楼

得分: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.为防伸手党，本站已停止会员注册。

第 4 楼

得分: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.为防伸手党，本站已停止会员注册。