一段VBA的代码,到处是坑

VBA不太会,要写一个题号检查的代码,实在不习惯反人类的语法格式,函数调用不打括号,返回值为函数等于,字符编码不一样,Find.Excute不支持变量,等等……每一个都让人抓耳挠腮,

记录一下半天,就写了下面几行代码,

 

'检查题号 2024-07-24
Sub CheckOrderNo()
    Dim text As String
    Dim cnt As Integer
    cnt = 0
    text = "【解析】"
    With ActiveDocument.Content.Find
        Do While .Execute(FindText:=text) = True
            cnt = cnt + 1
        Loop
    End With
    Dim i As Integer
    Dim t As Integer
    Dim no As String
    Dim repeat As String
    For i = 0 To cnt Step 1
        no = Str(i) & ""
        t = CountString(no)
        If (t > 1) Then
            repeat = repeat + "" + Str(i) + "题有" + Str(t) + "个;" + (Chr(13) & Chr(10))
        End If
    Next i
    If (Len(repeat) > 1) Then
        MsgBox repeat, vbOKOnly, "XMATH消息提示"
    Else
        repeat = "共[" + Str(cnt) + "]题,检查通过!"
        MsgBox repeat, vbOKOnly, "XMATH消息提示"
    End If
End Sub


'检查题号是否有重复2024-07-24
Function CountString(text As String) As Integer
    Dim Reg As New VBScript_RegExp_55.regexp
    Dim MC As VBScript_RegExp_55.MatchCollection
    Dim M As VBScript_RegExp_55.Match
    Dim Source As String
    Selection.WholeStory
    Source = Selection.text
    Dim oldTex As String
    Dim count As Integer
    count = 0
    With Reg
        .Global = True
        .Pattern = "\d+."
        Set MC = .Execute(Source)
        For Each M In MC
            oldTex = CStr(M.Value)
            If StrConv(Trim(M.Value), vbUnicode) = StrConv(Trim(text), vbUnicode) Then
                count = count + 1
            End If
        Next M
    End With
    CountString = count
End Function

 

posted @ 2024-07-24 13:31  猫狼  阅读(6)  评论(0编辑  收藏  举报