
心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
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
redim S(len(str) '重定义数组大小 For i = 1 To Len(str) s(i)=Asc(Mid(str, i, 1)) '保存ASCII码 Next
[此贴子已经被作者于2021-7-27 13:41编辑过]
'这二个文件名我测试用的 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
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
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