山地步兵呼叫版主(第三集群003-关于取得每行的未尾字符)

sdbbsdbb

仍是处理电子书的老问题，这次我欲将每个段落（如果是行，是否更麻烦？）的未尾可见字符取出，放入一个文件，并将除标点符号以外的字符删除（以观察行尾标点的特征，为日后提供智能分段程序作准备）。 前期工作已可作到，见下列程序（其实还是版主上次提供的取得各段字数的那个程序的框架），但这次速度又慢了，一个200多k仅3670行的（而一般电子书多达兆级）文件处理一下得三分钟以上，是否太慢了些，版主，能再快一些么？ 至于将非标点字符删除的工作，目前我还没有解决方案，E文标点还可用ASC码区域来限制一下，可中标点的ASC值有无一个范围？版主，有高招么？

Option Explicit Sub try() Dim FSO As Object, MyTxt As Object, MyFilePathName As String Dim i As Paragraph, Lenth As Long, ParCount As Long, xx1 As Long Debug.Print Now MyFilePathName = "D:\test\Ttt.txt" '定义一个文件名与路径变量 If Dir(MyFilePathName) <> "" Then Kill MyFilePathName '如果存在该文件则删除 Set FSO = CreateObject("Scripting.FileSystemObject") '定义一个FSO对象 Set MyTxt = FSO.CreateTextFile(MyFilePathName, True) '创建一个TXT文件 For Each i In ActiveDocument.Paragraphs '在活动文档的段落中循环 ParCount = ParCount + 1 '计数 xx1 = i.Range.End - i.Range.Start - 1 If xx1 > 2 Then _ Set myrange = ActiveDocument.Range(ActiveDocument.Paragraphs(ParCount). _ Range.End - 3, ActiveDocument.Paragraphs(ParCount).Range.End - 2) _ Else _ Set myrange = ActiveDocument.Range(ActiveDocument.Paragraphs(ParCount). _ Range.End - 2, ActiveDocument.Paragraphs(ParCount).Range.End - 2) _ MyTxt.Write myrange Next i MyTxt.Close '关闭 Debug.Print Now End Sub

PuZYa8DR.rar (116.94 KB, 下载次数: 20)

2005-4-24 12:02 上传

点击文件名下载附件
山地步兵呼叫版主(第三集群003-关于取得每行的未尾字符)

守柔

请你直接告诉我，你目前是否想取得每段（每行的话，运行速度则更慢）除段落标记之外的最后一个字符（无论该字符是否为标点，通常为标点），然后写入文本文件？还是写入WORD中？

无需删除，只需重新写入就可以了，何必删除呢？你要的只是最后一个可见字符呀？

sdbbsdbb

是这样的，我将每个段落的最后一个可见字符找出来，然后写入一个临时文件（就是D盘上的TTT文本文件），由于由PDF转化来的文本文件是每行一段，故每段未尾的可见字符绝对不大会“正好”是标点符号。不过这个写入的速度比较慢，因此，我希望您能设法加速。

至于为何需要将这个临时文件中的中文字符删除，我在头贴中已说明了，这个临时文件的目的是为了查看上述每一段落的未尾的标点符号到底有多少种？我将以这些标点符号作为分段的依据。

守柔

很简单，但程序运行，可能需要时间，因为在WORD中，一个RANGE对象耗用的内存是相对较大的，它不仅是包含字符信息，还有位置信息，格式信息，段落信息等等。就是罗列所有的中文标点符号的ASCII码或者标点符号，然后判断，段落最后一个可见字符（或者是其ASCII码，可以使用ASC（）函数获得）是否包含在该所有标点符号的字符串中（VBA.instr()>0)，则写入文本文件，否则，不用写入。当然，最后是写在内存变量中，最后一次性写入文本文件中。

sdbbsdbb

那么，VBA.instr()>0 是仅对应E文标点呢还是对应所有中E文标点符号？

守柔

以下是引用sdbbsdbb在2005-4-24 13:48:00的发言： 那么，VBA.instr()>0 是仅对应E文标点呢还是对应所有中E文标点符号？

做了一个简单的示例，供楼主参考： '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-4-24 14:02:37 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub Sample() Dim PutBox As String Const MyString As String = ",.?!<>…，。？……——“”《》!" & """" PutBox = InputBox("请输入任意字符") If PutBox = "" Then Exit Sub PutBox = VBA.Mid(PutBox, 1, 1) If VBA.InStr(MyString, PutBox) > 0 Then MsgBox "您所输入的字符是标点符号!", vbInformation Else MsgBox "您所输入的不是标点符号!", vbInformation End If End Sub '----------------------