przy użyciu regex i zamień zaktualizować pola adresowe z USPS skrótów w MS-Access

Question

Próbuję napisać funkcję VBA w programie Access, który zastępuje słowa w polu adresu ze standardowym United States Postal Abbreviations. Rozumiem, że to nigdy nie będzie doskonałe, ale chcę przynajmniej wykonać proste skróty (bez konieczności zakupu oprogramowania do formatowania adresów), np. , np.

input  output 
------- ------------- 
North -> N 
Street -> ST 
Drive -> DR 
Lane -> LN 

Myślałem o użyciu prostą tabelę do przechowywania łańcuch i łańcuch zastępczy, a następnie zapętlenie poprzez rekordów tej tabeli/wykonać proste wyszukiwanie i zastąpić za pomocą funkcji Replace(), np pomocą immediate window z:

?Replace("123 North 3rd St", "North", "N", compare:=vbTextCompare) 
123 N 3rd St 

Jednakże, sposób ten może potencjalnie powodować błędy np

?Replace("123 Northampton St", "North", "N", compare:=vbTextCompare) 
123 Nampton St 

Moja oryginalna strategia była utworzyć tabelę zastępczą z regularnych wzorów ekspresji i ciągi zamiennych, następnie pętli tej tabeli zrobić dokładniejsze wyszukiwania i zamiany.

pattern     abbrev 
-------------------  ------------ 
{pattern for North}  N 
{pattern for Street} ST 

zdałem sobie sprawę, że może być przesadą RegEx tutaj, zwłaszcza, że ​​mam zamiar zostać przelotowego pól adresowych w kółko w bazie danych, ale nie mógł myśleć o łatwiejszy sposób tylko przy użyciu funkcji Replace() (Aktualizacja: zobacz odpowiedzi z @ mwolfe02 i @Cylian oraz rozwiązania hybrydowego).

W powyższym przykładzie chcę wyszukać słowa Północ i Ulica, gdy są one jako istniejące jako słowo w ciągu znaków (w ten sposób oddzielone dwoma białymi spacjami) lub na końcu ciągu lub początku strunowy. Obejmuje to większość sytuacji uzasadniających skrót. np.

address      formatted 
----------------------  -------------------------- 
123 North 3rd St   -> 123 N 3RD ST 
123 ABC Street North  -> 123 ABC ST N 
North 3rd Street   -> N 3RD ST 
123 North Northampton St -> 123 N NORTHAMPTON ST 

jak w tych przykładach, chcę zastąpić wszystkie wystąpienia wzorca w łańcuchu. Konwertuję również wszystko na duże litery (mogę użyć UCase() na końcowym wyniku bez problemu).

Czy ktoś wie o istniejącym module, który robi tego rodzaju rzeczy? Czy ktokolwiek może pomóc przy dopasowywaniu wzorców, jak w powyższych przykładach? Aby uzyskać dodatkowy kredyt, jestem ciekawy również tworzenia reguły w tabeli do formatowania skrzynek pocztowych, np. np.

address     formatted 
---------------------- -------------------------- 
P.O. Box 345   -> PO BOX 345 
PO Box 345    -> PO BOX 345 
Post Office Box 345 -> PO BOX 345 
PO. Box 345   -> PO BOX 345 
P. O. Box 345   -> PO BOX 345 

This stack overflow post daje następujący wzór rozpoznawać pewne pola po "^ \ s * s.? \ S? O.? \ SB [oo] [XX]." (wprawdzie nie trzeci przykład powyżej). Ponownie, nie jestem tak wygodne z zestawami dopasowania i wymiany, aby dowiedzieć się, jak napisać tę dokładniejszą funkcję zastępowania. Czy istnieje ekspert RegEx/Access, który może pomóc?

Answer 1

I stworzył bardzo prosty stół odniesienia ref_USPS_abbrev z listy Skrót USPS Internecie. Oto wpisy, które odpowiadają początkowo podanemu przykładowi:

WORD   ABBREV 
------------ ------------- 
NORTH   N 
STREET  ST 

Następnie, dołączając odpowiedzi do mojego oryginalnego wpisu, utworzyłem dwie funkcje pomocnicze.

Od @Cylian:

' ----------------------------------------------------------------------' 
    ' Formats string containing P.O. Box to USPS Approved PO BOX format ' 
    ' ----------------------------------------------------------------------' 
    ' Requires Microsoft VBScript Regular Expressions 5.5 

    Public Function FormatPO(inputString As String) As String 

     Static rePO As Object 
     If rePO Is Nothing Then 
      Set rePO = CreateObject("vbscript.regexp") 
     With rePO 
     .Pattern = "\bP(?:[. ]+|ost +)?O(?:ff\.?(?:ice))" & _ 
        "?[. ]+B(?:ox|\.) +(\d+)\b" 
     .Global = True 
     .IgnoreCase = True 
     End With 
     End If 

     With rePO 
      If .Test(inputString) Then 
       FormatPO = .Replace(inputString, "PO BOX $1") 
      Else 
       FormatPO = inputString 
      End If 
     End With 
    End Function 

I, używając @ mwolfe02 za doskonały pomysł:

' ----------------------------------------------------------------------' 
    ' Replaces whole word only with an abbreviation in address string  ' 
    ' ----------------------------------------------------------------------' 

    Public Function AddressReplace(AddressLine As String, _ 
        FullName As String, _ 
        Abbrev As String) 

    'Enclose address line in an opening and closing space, so that you 
    'can require an opening and closing space on each word you are trying 
    'to replace. Finish up with a trim to get rid of those temporary spaces. 

    AddressReplace = Trim(Replace(" " & AddressLine & " ", _ 
           " " & FullName & " ", _ 
           " " & Abbrev & " ")) 
    End Function 

Następnie włączenie tych funkcji pomocniczych, napisałem tę funkcję:

' ----------------------------------------------------------------------' 
' Format address using abbreviations stored in table ref_USPS_abbrev ' 
' ----------------------------------------------------------------------' 
' Requires Microsoft DAO 3.6 Object Library 
' Table ref_USPS_abbrev has two fields: WORD (containing the word to match) 
' and ABBREV containing the desired abbreviated substitution. 
' United States Postal Services abbreviations are available at: 
' https://www.usps.com/ship/official-abbreviations.htm 

Public Function SubstituteUSPS(address As String) As String 

Static dba As DAO.Database 
Static rst_abbrev As DAO.Recordset 

    If IsNull(address) Then Exit Function 

    'Initialize the objects 

    If dba Is Nothing Then 
     Set dba = CurrentDb 
    End If 

    'Create the rst_abbrev recordset once from ref_USPS_abbrev. If additional 
    'entries are added to the source ref_USPS_abbrev table after the recordset 
    'is created, since it is an dbOpenTable (by default), the recordset will 
    'be updated dynamically. If you use dbOpenSnapshot it will not update 
    'dynamically. 

    If rst_abbrev Is Nothing Then 
     Set rst_abbrev = dba.OpenRecordset("ref_USPS_abbrev", _ 
              Type:=dbOpenTable) 
    End If 

    'Since rst_abbrev is a static object, in the event the function is called 
    'in succession (e.g. while looping through a recordset to update values), 
    'move to the first entry in the recordset each time the function is 
    'called. 

    rst_abbrev.MoveFirst 

    'Only call the FormatPO helper function if the address has the 
    'string "ox" in it.  

    If InStr(address, "ox") > 0 Then 
     address = FormatPO(address) 
    End If 

    'Loop through the recordset containing the abbreviations 
    'and use the AddressReplace helper function to substitute 
    'abbreviations for whole words only. 

    Do Until rst_abbrev.EOF 
     address = AddressReplace(address, rst_abbrev![WORD], _ 
           rst_abbrev![ABBREV]) 
     rst_abbrev.MoveNext 
    Loop 

    'Convert the address to upper case and trim white spaces and return result 
    'You can also add code here to trim out punctuation in the address, too. 

    SubstituteUSPS = Trim(UCase(address)) 

End Function 

Aby utwórz tabelę do testowania: ref_USPS_abbrev:

Sub CreateUSPSTable() 

Dim dbs As Database 
Set dbs = CurrentDb 

With dbs 
    .Execute "CREATE TABLE ref_USPS_abbrev " _ 
     & "(WORD CHAR, ABBREV CHAR);" 
    .Execute " INSERT INTO ref_USPS_abbrev " _ 
     & "(WORD, ABBREV) VALUES " _ 
     & "('NORTH', 'N');" 
    .Execute " INSERT INTO ref_USPS_abbrev " _ 
     & "(WORD, ABBREV) VALUES " _ 
     & "('STREET', 'ST');" 
    .Close 
End With 
End Sub 

Wreszcie, testując tę ​​funkcję z immediate window:

CreateUSPSTable 
?SubstituteUSPS("Post Office Box 345 123 North Northampton Street") 
PO BOX 345 123 N NORTHAMPTON ST 

Nie jestem programistą profesjonalnie, więc chciałbym powitać propozycje sprzątanie mojego kodu jeszcze dalej, ale na razie to działa wspaniały. Dziękuję wszystkim.

Stack Overflow jeszcze raz FTW!

Answer 2

Spróbuj funkcję

Public Function FormatPO(inputString$) 
'This example uses **Microsoft VBScript Regular Expressions 5.5** 
Dim re As New RegExp, result$ 
With re 
    .Pattern = "\bP(?:[. ]+|ost +)?O(?:ff\.?(?:ice))?[. ]+B(?:ox|\.) +(\d+)\b" 
    .Global = True 
    .IgnoreCase = True 
    If .test(inputString) Then 
     FormatPO = .Replace(inputString, "PO BOX $1") 
    Else 
     MsgBox "Data doesn't matched!" 
    End If 
End With 

i można nazwać jako (od immediate window)

?FormatPO("P.O. Box 563") 

daje Wynik

PO BOX 563 

---

Dopasowany wzór dla nazw ulic i adresów wymaga więcej czasu. Ale możesz odwiedzić stronę internetową here i zbudować RegEx online.

Mam nadzieję, że to pomoże.

Answer 3

@Cylian ma dobrą odpowiedź na drugą część pytania. Spróbuję rozwiązać ten pierwszy. Jeśli jedynym problemem jest to, że wymienić całe słowa w adresie wtedy następująca funkcja zrobi co trzeba:

Function AddressReplace(AddressLine As String, _ 
         FullName As String, _ 
         Abbrev As String) 
    AddressReplace = Trim(Replace(" " & AddressLine & " ", _ 
            " " & FullName & " ", _ 
            " " & Abbrev & " ")) 
End Function 

To zamyka linię adresową w przestrzeni otwierania i zamykania, dzięki czemu można wymagać otwór i zamykając miejsce na każde słowo, które próbujesz zastąpić. Kończy się wykończeniem, aby pozbyć się tych tymczasowych przestrzeni.

Poniższa procedura sprawdza kod i produkuje wyjście szukasz:

Sub TestAddressReplace() 
    Debug.Print AddressReplace("123 North 3rd St", "North", "N") 
    Debug.Print AddressReplace("123 Northampton St", "North", "N") 
End Sub 

Answer 4

USPS ma bezpłatny interfejs API do sprawdzania poprawności i standaryzacji adresów. Będziesz musiał zarejestrować się w usłudze (szybko), a następnie użyć swojego identyfikatora/hasła w interfejsie API, aby odnieść się do ich witryny. Wykonuje całą pracę za ciebie i ma przykładowy kod. Kanadyjska usługa pocztowa ma to samo (nie wiem, czy jest za darmo).

https://www.usps.com/business/web-tools-apis/welcome.htm

B. Sevier