Sub replacetest0() '2012/6/5 http://blog.bestdaylong.com/2008/07/word.html
Dim a As Range, x As Long, q As String
Dim s As Date, e As Date, g, i
'Set a = ActiveDocument.Range
'Debug.Print Len(a)
s = VBA.Timer
q = ActiveDocument.Range
x = InStr(q, "翁方綱")
'x = InStr(a.Text, "翁方綱")
For Each g In ActiveDocument.Comments
g.Delete
Next
With ActiveDocument
Do Until x = 0
' .Range(x - 1, x + 3 - 1).Select
.Range(x - 1, x + Len("翁方綱") - 1).Text = "孫守真"
i = i + 1
' If i = 68 Then Stop
x = InStr(x + 1, q, "翁方綱")
If .Range(x - 1, x + 3 - 1) <> "翁方綱" Then
e = VBA.Timer
Debug.Print e - s
Debug.Print i
Stop
End If
'a.Text = Replace(a.Text, "翁方綱", "孫守真")
'a.Find.Execute "翁方綱", , , , , , , , , "孫守真", wdReplaceAll '果然太慢!!
Loop
End With
e = VBA.Timer
Debug.Print e - s
End Sub