|
说明:
本次VBA竞赛题，考查的是大家对WORD中RANGE对象的理解，从大家的代码情况来看，总体不错，字、词、句、段落、SELECTION对象等，基本上都出现了。
这个竞赛题，从代码的思路来说，有两种情况：
一是使用查找；二是遍历各字（词），显然，查找优于遍历；
从代码方法上说，也有几种情况
使用SELECTION对象和方法，也可以使用RANGE对象和方法，从我们完成的结果而言，此处，SELECTION对象快于RANGE对象，这是查找中SELECTION对象有其天然优势，WORD中设置SELECTION对象时，WORD会自动缩减范围（递减），而RANGE对象如果要递减则需要设置代码（目前无法找到理论依据，我的推论）
在处理段落中“只”数时，思路基本一致，对于段落数的处理，至少有三种方法，从1到段落总数的循环，使用RANGE对象获得当前段落数，使用END属性判断是否处于同一段落等等。
除了参赛选手提供的这些代码外，我另外写了一些代码，它们可根据不同的情况进行使用，供大家参考。
代码包括参赛选手代码运行时间，只是一个相对概念，机器配置和运行时间（同一电脑，今天与明天的运行）的不同，可能会有出入，仅供参考。
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-10-22 10:17:26
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'№ 00067^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit '显式变量声明
'说明:为了正确比较代码执行的效率,我把文档从8个段落扩大到了48个段落
'以利于各个代码运行时间的精确比较
'测试电脑的配置:CPU :Inter Celeron 534MHZ,RAM:264M,WIN2000,WORDXP
Function myColor(P As Integer, N As Integer) As WdColor
If P Mod 2 = 0 Then
If N Mod 2 = 0 Then myColor = wdColorRed Else myColor = wdColorBlue
Else
If N Mod 2 = 0 Then myColor = wdColorBlue Else myColor = wdColorRed
End If
End Function
'----------------------
Sub Example1()
'本过程用时3.72S
Dim intCount As Integer, ParCount As Integer, OldPostion As Long, EndPostion As Long
Debug.Print Timer ' 33242.21
Application.ScreenUpdating = False '关闭屏幕更新
With Selection
.HomeKey wdStory '移到文档首(强制从头开始搜索)
With .Find
.ClearFormatting '清除格式查找
.Text = "只" '查找内容为"只"
Do While .Execute = True '每次成功查找后
'获得选定内容(被查找的项目)的段落标记所在位置
EndPostion = Selection.Paragraphs(1).Range.End
'当变量OldPostion值小于EndPostion时,将所选内容的段落标记位置赋值给OldPostion
'也就是说,如果当前所选内容的段落标记位置与原位置(OldPostion)不等时,说明已进入下一个段落
'段落数(变量ParCount)进行累加,intCount归零,将EndPostion(新位置)重新赋值给OldPostion
If OldPostion < EndPostion Then ParCount = ParCount + 1: intCount = 0: OldPostion = EndPostion
intCount = intCount + 1 '累加
'查找到的内容的颜色根据FUNCTION过程,设置其颜色
Selection.Font.Color = myColor(ParCount, intCount)
Loop
End With
End With
Application.ScreenUpdating = True '恢复屏幕更新
Debug.Print Timer ' 33245.78
End Sub
'----------------------
Sub Example2()
'本过程用时5.07秒
Dim ParRange As Range, intCount As Integer, ParCount As Integer
Debug.Print Timer
Application.ScreenUpdating = False '关闭屏幕更新
Selection.WholeStory '全选
With Selection.Find
.ClearFormatting '清除查找格式
.Text = "只" '设置查找内容
.Forward = True '向下查找
Do While .Execute = True '每次成功查找
'定义一个RANGE对象,为文档开始(0)位置到所查找的段落标记所在位置
Set ParRange = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End)
'如果该RANGE对象的段落数>原有的段落数(也是说明查找已进行到下一个段落)则变量intCount=0
If ParRange.Paragraphs.Count > ParCount Then intCount = 0
'累加
intCount = intCount + 1
'将现在RANGE对象的段落数赋值给变量ParCount
ParCount = ParRange.Paragraphs.Count
'设置所选内容的字体颜色
Selection.Font.Color = myColor(ParCount, intCount)
Loop
End With
Application.ScreenUpdating = True '恢复屏幕更新
Debug.Print Timer
End Sub
'----------------------
Sub Example3()
'本过程运行用时10.74秒
Dim myRange As Range, OldPostion As Long, intCount As Integer, ParCount As Integer
Debug.Print Timer
Application.ScreenUpdating = False '关闭屏幕更新
Set myRange = ActiveDocument.Content '设置一个RANGE对象
'注意,每次成功查找后,WORD会自动重新定义该Range对象(即为查找内容所在的RANGE)
'注意,在这个过程中,我们使用了格式查找,否则将进入死循环
With myRange.Find '查找
.ClearFormatting
.Text = "只"
.Format = True
.Font.Color = wdColorAutomatic '带格式(查找自动色(黑)的"只"的文本)查找
Do While .Execute = True '每次成功查找
'如果原变量位置小于现在myRange所在的段落标记位置时,变量ParCount累加(段落数):intCount则归零重新开始
If OldPostion < myRange.Paragraphs(1).Range.End Then ParCount = ParCount + 1: intCount = 0
intCount = intCount + 1 '累加
'将myRange所在的段落结束位置赋值于OldPostion
OldPostion = myRange.Paragraphs(1).Range.End
'将myRange字体颜色根据FUNCTION过程值设置
myRange.Font.Color = myColor(ParCount, intCount)
Loop
End With
Application.ScreenUpdating = True '恢复屏幕更新
Debug.Print Timer
End Sub
'----------------------
Sub Example4()
'本过程运行用时12.64秒
Dim ParCount As Integer, i As Integer, myRange As Range, ZhiCount As Integer
Debug.Print Timer ' 22026.89
Application.ScreenUpdating = False '关闭屏幕更新
With ActiveDocument
ParCount = .Paragraphs.Count '获得文档段落总数
For i = 1 To ParCount '建立一个循环
ZhiCount = 0 '初始化变量值
GN: Set myRange = .Paragraphs(i).Range '定义一个RANGE对象为该段落所在的RANGE
With myRange.Find '查找
.ClearFormatting '清除格式查找
.Text = "只"
.Format = True
.Font.Color = wdColorAutomatic '也是带格式的查找
Do While .Execute '每次成功查找
ZhiCount = ZhiCount + 1 '累加
'根据FUNCTION过程值设置字体颜色
myRange.Font.Color = myColor(i, ZhiCount)
GoTo GN '返回GN行
Loop
End With
Next
End With
Application.ScreenUpdating = True
Debug.Print Timer '22039.53
End Sub
'----------------------
Sub Example5()
'本过程运行用时12.66秒
Dim myRange As Range, intTemp As Integer, intCount As Integer, ParCount As Integer
Dim TempRange As Range, A As Integer
Debug.Print Timer
Application.ScreenUpdating = False '关闭屏幕更新
Set myRange = ActiveDocument.Content '定义一个RANGE对象
GN: With myRange.Find '查找
ParCount = myRange.Paragraphs.Count '取得指定RANGE对象的段落总数
.ClearFormatting '不限定格式查找
.Text = "只"
Do While .Execute = True '每次成功查找
'定义一个RANGE对象,为从myRange对象的结束位置开始,到文档的结束位置
Set TempRange = ActiveDocument.Range(myRange.End, ActiveDocument.Content.End)
'取得TempRange对象的段落总数
intTemp = TempRange.Paragraphs.Count
'如果两者不相等(说明上一次查找与本次查找不在同一段落上),则intCount = 0: A = A + 1
If intTemp <> ParCount Then intCount = 0: A = A + 1
intCount = intCount + 1 '累加
'设置myRange字体的颜色
myRange.Font.Color = myColor(A, intCount)
Set myRange = TempRange '重新定义该RANGE对象(递减了RANGE对象,下一次的查找从本次查找的结束位置到全文结束位置)
GoTo GN '返回GN行号
Loop
End With
Application.ScreenUpdating = True '恢复屏幕更新
Debug.Print Timer
End Sub
'----------------------
Sub Example6()
'本过程运行用时34.34秒
Dim i As Range, intCount As Integer, ParCount As Integer, ParRange As Range
Debug.Print Timer
Application.ScreenUpdating = False '关闭屏幕更新
For Each i In ActiveDocument.Words '遍历文档词组
If i = "只" Then '如果为"只"
'定义一个RANGE对象,为从0开始到该词(字符)所在段落标记位置
'也可以同EXAMPLE1一样,直接使用END属性而不用段落数来判断,更快一些
Set ParRange = ActiveDocument.Range(0, i.Paragraphs(1).Range.End)
'如果两者不等,则说明进入了下一个段落,intCount = 0
If ParRange.Paragraphs.Count > ParCount Then intCount = 0
intCount = intCount + 1 '累加
'取得指定对象段落数
ParCount = ParRange.Paragraphs.Count
'设置字体颜色
i.Font.Color = myColor(ParCount, intCount)
End If
Next
Application.ScreenUpdating = True '恢复屏幕更新
Debug.Print Timer
End Sub
'----------------------
[此贴子已经被作者于2005-10-22 10:20:54编辑过] | 
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-10-3 07:06
发表于 2005-10-6 19:22
楼主