6

我正在尝试在 Access 中编写一个 VBA 函数，用标准的United States Postal Abbreviations替换地址字段中的单词。我意识到这永远不会完美，但我想至少做简单的缩写（无需购买地址格式化软件），例如

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

我考虑过使用一个简单的表来存储字符串和替换字符串，然后遍历该表/记录集以使用该Replace()函数执行简单的搜索和替换，例如使用immediate window：

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

但是，此方法可能会导致错误，例如

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

我最初的策略是创建一个带有正则表达式模式和替换字符串的替换表，然后遍历该表以进行更精确的搜索和替换。

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

我意识到 RegEx 在这里可能有点矫枉过正，特别是因为我将在数据库中一遍又一遍地遍历地址字段，但想不出仅使用该Replace()函数的更简单方法（更新：请参阅 @mwolfe02 的回复和@Cylian，以及一个混合解决方案）。

在上面的示例中，我想搜索单词 North 和 Street 当它们在字符串中作为单词存在（因此由两个空格分隔）或在字符串的末尾或字符串的开头时。这涵盖了需要缩写的大多数情况。例如 

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

在这些示例中，我想替换字符串中模式的所有实例。我还将所有内容都转换为大写（我可以UCase()在最终结果上使用没问题）。

有谁知道做这种事情的现有模块？任何人都可以帮助进行上述示例中的模式匹配吗？对于额外的信用，我也很好奇在表格中创建规则以格式化邮政信箱，例如 

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

这个堆栈溢出帖子给出了以下模式来识别一些邮政信箱“^\s*P.?\s?O.?\sB[Oo][Xx]”。（诚​​然不是上面的第三个例子）。同样，我不太喜欢匹配和替换集来弄清楚如何编写这个更精确的替换函数。是否有 RegEx/Access 专家可以提供帮助？

4

4 回答 4

5

试试这个功能

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

并且可以称为 (from immediate window)

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

给出结果

PO BOX 563

街道名称与地址的匹配模式需要更多时间来构建。但是您可以访问此处并在线构建您的 RegEx。

希望这可以帮助。

于 2012-05-29T09:19:34.293 回答
2

@Cylian has a good answer for the second part of your question. I'll try to address the first. If your only concern is that you replace whole words in the address then the following function will do what you need:

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

It encloses the 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. It finishes up with a trim to get rid of those temporary spaces.

The following procedure tests the code and produces the output you are looking for:

Sub TestAddressReplace()
    Debug.Print AddressReplace("123 North 3rd St", "North", "N")
    Debug.Print AddressReplace("123 Northampton St", "North", "N")
End Sub
于 2012-05-29T13:12:42.763 回答
2

USPS 有一个免费的查找 API 来验证和标准化地址。您将需要注册该服务（快速），然后在 API 中使用您的 ID/密码来反弹他们的网站。为您完成所有工作，并提供示例代码。加拿大邮政服务也有同样的东西（虽然不确定它是免费的）。

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

B.塞维尔

于 2016-02-17T14:50:22.887 回答
0

我从在线 USPS 缩写列表中创建了一个非常简单的参考表ref_USPS_abbrev 。以下是与最初给出的示例相对应的条目：

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

然后，结合对我原始帖子的回复，我创建了两个辅助函数。

来自@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！

于 2012-05-29T20:20:13.523 回答