[求助]怎样用VBA将“{”和“}”分别替换成域标记的左右括号？

ssq1109

将一文本格式的文件进行适当的替换后以便能转换成WORD中的域代码，经初步替换后文中有大量类似下列文本的内容： {eq \f(1,{eq \r({eq \f(b,a)})})} 注意：上面的“{}”有相互嵌套的情况（有的又没有嵌套），且文中不止一个此类文本，如又有： {eq \r(3,{eq \f(1,2)})} 还可能有更多。 但这不是真正的域代码，因为“{}”是ASCII字符而不是域标记，如果能将文中的所有“{”都替换成域标记左括号，将所有“}”都替换成域标记右括号，上述2例就成了真正的域代码，这样再按Alt+F9或在VBA中执行相应的命令即可得公式。 请高手相助！谢谢！！ [em09]

ssq1109

我根据守柔大侠的一处代码改写了一下，应该能初步达到目的，但我刚才试了一下，对一10页文件，费时太长，各位高手能否帮我优化一下，最好能提高效率和速度。

Sub TXT2EQ()

Dim SelStart As Long, SelRange As Range, NewSelStart As Long
Dim i As Range, MyPost As Long
On Error Resume Next
Application.ScreenUpdating = False
With ActiveDocument
SelStart = .Start '定义一个起始位置
Set SelRange = .Range '定义一个区域为选定区域
End With
While InStr(SelRange, "{") > 0 '设置如果指定区域中含有"{"则进入循环
NewSelStart = SelStart '定义一个开始位置
Set i = ActiveDocument.Range(NewSelStart, NewSelStart + 1)
While i <> "}" '设置如果i的文本值不是为"}"则进入循环
Set i = ActiveDocument.Range(NewSelStart, NewSelStart + 1) '重新定义i的区域
NewSelStart = NewSelStart + 1 '将i的起点位置下移一个字符位置
If i = "{" Then MyPost = NewSelStart - 1 '取得当i="{"的位置
Wend
'定义一个新区域
Set MyRange = ActiveDocument.Range(MyPost, NewSelStart)
With MyRange
.Characters(1) = "" '将{删除
.Characters(.Characters.Count) = "" '将}删除
.Select '选定
End With
Application.Run "InsertFieldChars" '插入域标志
Wend
Application.ScreenUpdating = True '恢复屏幕更新
End Sub

守柔

草作，仅供参考，请测试一下：

Option Explicit
Sub Example()
Dim myRange As Range, TempRange As Range, lngStart As Long, lngEnd As Long
Dim FieldRange As Range, oField As Field
Application.ScreenUpdating = False
With ActiveDocument
GN: Set myRange = ActiveDocument.Content
With myRange.Find
.Text = "}"
Do While .Execute(replacewith:="", Replace:=wdReplaceOne)
lngEnd = myRange.End - 1
Set TempRange = ActiveDocument.Range(0, lngEnd)
With TempRange.Find
.Text = "{"
.Forward = False
If .Execute(replacewith:="", Replace:=wdReplaceOne) Then
lngStart = TempRange.Start
Set FieldRange = ActiveDocument.Range(lngStart, lngEnd)
FieldRange.Select
Application.Run "InsertFieldChars"
End If
End With
GoTo GN
Loop
End With
.Fields.Update
.ActiveWindow.View.ShowFieldCodes = False
End With
Application.ScreenUpdating = True
End Sub

ssq1109

高手出手，就是不凡！非常谢谢守柔大侠！

3楼的代码快很多，文件短优势不算大，但我用一20页的文件测试，3楼的用时4分20秒，2楼的用时31分17秒，中途像是假死，但能看到滚动条的滑块缓缓下滑。

ssq1109

运用3楼的代码中的原理，还可以再加上转换表格的功能，但有几个问题我总是解决不了，反复看VBA的帮助文件也无获。请高手相助。 问题见附件。 Sub TXT2WORD() '处理EQ域 Dim myRange As Range, TempRange As Range, lngStart As Long, lngEnd As Long Dim FieldRange As Range, oField As Field Dim TableRange As Range, oTable As Table Application.ScreenUpdating = False With ActiveDocument GN: Set myRange = ActiveDocument.Content With myRange.Find .Text = "}" Do While .Execute(replacewith:="", Replace:=wdReplaceOne) lngEnd = myRange.End - 1 Set TempRange = ActiveDocument.Range(0, lngEnd) With TempRange.Find .Text = "{" .Forward = False If .Execute(replacewith:="", Replace:=wdReplaceOne) Then lngStart = TempRange.Start Set FieldRange = ActiveDocument.Range(lngStart, lngEnd) FieldRange.Select Application.Run "InsertFieldChars" End If End With GoTo GN Loop End With .Fields.Update .ActiveWindow.View.ShowFieldCodes = False End With '处理表格 With ActiveDocument GN1: Set myRange = ActiveDocument.Content With myRange.Find .Text = "~" Do While .Execute(replacewith:="", Replace:=wdReplaceOne) lngEnd = myRange.End - 1 Set TempRange = ActiveDocument.Range(0, lngEnd) With TempRange.Find .Text = "`" .Forward = False If .Execute(replacewith:="", Replace:=wdReplaceOne) Then lngStart = TempRange.Start Set TableRange = ActiveDocument.Range(lngStart, lngEnd) TableRange.Select With Selection .ConvertToTable Separator:=wdSeparateByCommas '转换成表格 .Columns.AutoFit '调整所有列宽使之适于文本宽度 End With End If End With GoTo GN1 Loop End With End With Application.ScreenUpdating = True End Sub K4JZIjG1.rar (27.63 KB, 下载次数: 12)

2006-4-26 10:01 上传

点击文件名下载附件
[求助]怎样用VBA将“{”和“}”分别替换成域标记的左右括号？

[em09]

ssq1109

分析了一下代码，表格嵌套错位问题应是先转换子表后转换总表（即先里后外）造成的。但怎么解决这个问题呢？