kerrypnx
11/20/2018 - 7:01 AM

检测错误的邮编

revise 11-20

Sub incorrectPostCode()
Dim affCount, i As Integer
Dim c As Range
Selection.HomeKey wdStory
With Selection.Find
    .ClearFormatting
    .Text = "Correspondence:"
    .MatchWildcards = False
    .Replacement.Text = ""
    .Execute
End With
 Dim L As Integer
Dim myrange As Range
Set myrange = ActiveDocument.Range(ActiveDocument.Paragraphs(3).Range.Start, Selection.Start)
affCount = myrange.Paragraphs.count
    For i = 4 To 1 + affCount
        ActiveDocument.Paragraphs(i).Range.Select
         If InStr(Selection.Text, ";") > 0 Then
       
            L = InStr(Selection.Text, ";")
            Selection.Collapse wdCollapseStart
            Selection.MoveRight wdCharacter, L, wdExtend
            

        Else
            Selection.Paragraphs(1).Range.Select
        End If
        
        
       detectPostCode (Selection.Text)
    Next
End Sub
Function detectPostCode(str As String)
Dim reg As New RegExp
Dim city, state, country As String
Asian = "China,Korea,Taiwan,Vietnam,Thailand,UK"
Eur = "France,Germany,Australia,Spain,TheNetherlands,Denmark,Hungary,CzechRepublic,Poland,Serbia"
US = "Canada,USA"
    With reg
        .Global = True
        .Pattern = ",([^,]+?),([^,]+),([^,]+?$)"
        Set matches = .Execute(str)
    End With
If reg.test(str) = True Then
city = Trim(CStr(matches(0).SubMatches(0)))
state = Trim(CStr(matches(0).SubMatches(1)))
country = Trim(CStr(matches(0).SubMatches(2)))
country = Left(country, Len(country) - 1)
country = Trim(country)
    If InStr(Asian, country) > 0 Then
    
        If verifyPostCode(CStr(city), "Asian") = False And verifyPostCode(CStr(state), "Asian") = False Then
            Call highlightPostCode(CStr(state), CStr(city), matches(0).firstindex + 2)
        End If
        
    Else
        If InStr(Eur, country) > 0 Then
        
            If verifyPostCode(CStr(city), "Eur") = False And verifyPostCode(CStr(state), "Eur") = False Then
                Call highlightPostCode(CStr(state), CStr(city), matches(0).firstindex + 2)
            End If

        Else
        
            If InStr(US, country) > 0 Then
                If verifyPostCode(CStr(state), "US") = False Then
                    Call highlightPostCode(CStr(state), CStr(city), matches(0).firstindex + 2)
                End If
            Else
            End If
            
        End If
    End If
    
End If
End Function
Function verifyPostCode(str As String, str1 As String) As Boolean
verifyPostCode = False
Dim arr
If InStr(str, " ") = 0 Then
    Exit Function
End If
 arr = Split(str, " ")
Select Case str1
    Case "Asian"
            If FunctionGroup.existNum(CStr(arr(0))) = False And FunctionGroup.existNum(CStr(arr(1))) = True Then
                verifyPostCode = True
            End If
    Case "Eur"
            If FunctionGroup.existNum(CStr(arr(0))) And FunctionGroup.existNum(CStr(arr(1))) = False Then
                verifyPostCode = True
            End If
    Case "US"
            If Len(arr(0)) = 2 And FunctionGroup.existNum(CStr(arr(1))) Then
                verifyPostCode = True
            End If
End Select
 

End Function
Sub highlightPostCode(state, city As String, L As Integer)
    With Selection
        .Collapse wdCollapseStart
        .MoveRight wdCharacter, L
        .MoveEndUntil ","
        If FunctionGroup.existNum(CStr(state)) Or FunctionGroup.existNum(CStr(city)) = False Then
            .MoveRight wdCharacter, 2
            .MoveEndUntil ","
        End If
        .Range.HighlightColorIndex = wdRed
        .Range.comments.Add .Range, "Position of the post/zip code is incorrect; For Asian Countries, the post code should be put after the city; For most European Countries except the UK, the post code should be put before the city; For USA and Canada, the zip code should be put after the state/province abbreviation"
    End With
End Sub