オンラインのUSPS略語リストから非常に単純な参照テーブルref_USPS_abbrevを作成しました。最初に示した例に対応するエントリは次のとおりです。
WORD ABBREV
------------ -------------
NORTH N
STREET ST
次に、元の投稿への応答を組み込んで、2つのヘルパー関数を作成しました。
@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
そして、@ mwolfe02の優れたアイデアを使用して：
' ----------------------------------------------------------------------'
' 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
次に、これらのヘルパー関数を組み込んで、次の関数を作成しました。
' ----------------------------------------------------------------------'
' 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
テスト用の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
immediate window最後に、 ：からこの関数をテストします。
CreateUSPSTable
?SubstituteUSPS("Post Office Box 345 123 North Northampton Street")
PO BOX 345 123 N NORTHAMPTON ST
私はプロのプログラマーではないので、コードをさらにクリーンアップするための提案を歓迎しますが、今のところこれはうまく機能します。みんな、ありがとう。
スタックオーバーフローがまたもやFTW！