Sub 调用函数()Call 查找是否有重复连续字符(10)End SubSub 查找是否有重复连续字符(x As Integer)'获取用户输入的字符串长度Dim charCount As IntegercharCount = x
' charCount = InputBox("请输入连续字符的个数：")If charCount <= 1 ThenMsgBox "请输入大于1的整数。"Exit SubEnd IfSelection.HomeKey Unit:=wdStory, Extend:=wdMove '回到文档的起点'定义变量Dim doc As DocumentDim rng As RangeSet doc = ActiveDocumentSet rng = doc.ContentDim 第一次出现位置 As LongDim 第二次出现位置 As LongDim 找到, 一直找不到 As Boolean'遍历查找连续字符Do While rng.Find.Execute(findText:=String(charCount, "?"), MatchWildcards:=True)'获取连续字符文本Dim strText As StringstrText = rng.TextCall 查找(strText, False, True)第一次出现位置 = rng.Start' '将光标移动到文本末尾
' rng.MoveEnd wdCharacter, Len(strText)'检查是否有重复的字符，并获取光标位置Call 查找(strText, False, True)找到 = Selection.Find.Found '若查找到则返回True一直找不到 = 找到 Or 一直找不到If 找到 Then第二次出现位置 = Selection.StartIf 第二次出现位置 = 第一次出现位置 Then'不执行操作Else'弹窗提示重复的字符，并显示光标位置Dim 弹窗 As VbMsgBoxResult弹窗 = MsgBox("发现重复的" & charCount & "个连续字符：" & strText & vbCrLf & _"出现位置：" & 第一次出现位置 & " 和 " & 第二次出现位置 & vbCrLf & _"是否选中第一个重复字符？", vbYesNoCancel)'根据用户选择选中光标位置If 弹窗 = vbYes ThenSelection.SetRange Start:=第一次出现位置, End:=第一次出现位置 + charCount '选中Exit SubElseIf 弹窗 = vbNo Then'不执行操作ElseIf 弹窗 = vbCancel ThenExit SubEnd IfEnd IfEnd IfLoopIf 一直找不到 = 0 ThenMsgBox ("文档没有重复的内容")ElseMsgBox ("文档有重复的内容")End If
End SubFunction 查找(文本, 通配符, 向下)Selection.Find.Font.ResetSelection.Find.ParagraphFormat.ResetWith Selection.Find.Text = 文本.Forward = 向下.Wrap = wdFindContinue.MatchCase = True.MatchByte = True.MatchWildcards = 通配符.MatchWholeWord = False.MatchFuzzy = False.Replacement.Text = ""End WithSelection.Find.Execute Replace:=wdReplaceNoneSelection.Find.Replacement.Text = ""
End Function
本文来自互联网用户投稿，文章观点仅代表作者本人，不代表本站立场，不承担相关法律责任。如若转载，请注明出处。 如若内容造成侵权/违法违规/事实不符，请点击【内容举报】进行投诉反馈！
