Access交流中心

北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |

Access问答 → 查找匹配

查找匹配

sunrise　 发表于：2019-08-16 08:56:15 　
复制

各位大神，导入表根据地址库中的条件路名门牌号（奇/偶数或全部的门牌号）。分出自
动填入相对应的配送站，谢谢！点击下载此附件

 

Top
西出阳关无故人 发表于：2019-08-16 11:39:44

参考：

Private Sub Command78_Click()
    Dim i As Long
    Dim SQL, A
    Dim Rec As New ADODB.Recordset
    For i = 1 To Me.导入匹配.Form.RecordsetClone.RecordCount
        Me.导入匹配.Form.SelTop = i
        Select Case GetNum(Me.导入匹配!地址) Mod 2
        Case 0    '地址为偶数
            A = "偶"
        Case 1
            A = "奇"
        End Select
        SQL = "select * from 地址库 where (路名='" & Mid(Me.导入匹配!地址, 1, InStr(Me.导入匹配!地址, "路")) & "' and (奇偶性='全部' OR 奇偶性='" & A & "'))"
        Rec.Open SQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly
        If Rec.RecordCount > 0 Then
            Me.导入匹配!匹配站点 = Rec.Fields(1)
        Else
            Me.导入匹配!匹配站点 = ""
        End If
        Rec.Close
    Next i
End Sub
Function GetNum(Exp As String) As Double
    Dim lntI As Long
    Dim strWord As String
    For lntI = 1 To Len(Exp)
        strWord = Mid(Exp, lntI, 1)
        If strWord Like "[0-9]" Then
            GetNum = GetNum & strWord
        End If
    Next
End Function




Top
sunrise 发表于：2019-08-16 17:13:06

上面的代码出现如下提示.



Top
西出阳关无故人 发表于：2019-08-17 09:40:21
添加引用 ado

Top
西出阳关无故人 发表于：2019-08-17 10:06:45

...

Dim Rec As New ADODB.Recordset

...

或者用以下代码替换这一句：

...

DIM Rec as object

set Rec=createobject("adodb.recordset")

...



Top
sunrise 发表于：2019-08-17 10:29:49

替换后又出现下面提示



Top
西出阳关无故人 发表于：2019-08-17 20:35:08

**的用下面替换

Rec.Open SQL, CurrentProject.Connection, 3, 1



Top
sunrise 发表于：2019-08-20 15:09:03

谢谢大神.

上面的修改后可以用了.

但现在又发现几个问题，

1、匹配地址路名前面有城市，或行政区的文字就匹配不了。

2、路名那个字段如果有小区名，或楼盘名就匹配不了。   

有没有更好，更智能准确地匹配出呢？谢谢了！点击下载此附件 



Top
sunrise 发表于：2019-08-21 10:15:43

还有一个问题

1、同一路名，起止门牌号1至500号，奇数门牌和偶数门牌属不同的配送站。 起止号500至1000号的奇数门牌和偶数门牌又是不同的配送站。

附件里的导入表，3-4行就匹配错了。点击下载此附件



Top
西出阳关无故人 发表于：2019-08-21 11:06:47

增加的这些情况，看了要对导入的表（按照地址库的格式）进行整理规范，省份、城市、区镇、路名、门牌号，然后才能处理。会不会还有其他情况？

可以考虑反过来，循环地址库，根据地址库的路名、起止门牌号去查找导入表的地址中是否包含地址库路名？如果包含，就按照门牌号的奇偶性、分段的情况去对应。



Top
西出阳关无故人 发表于：2019-08-21 12:01:54

参考点击下载此附件（新增按钮及事件）：

'引用 Microsoft  ActiveX data objects 2.8 ...

Private Sub Command84_Click()
    Dim recA As New ADODB.Recordset
    Dim recB As New ADODB.Recordset
    Dim i, j
    Dim 门牌号 As Long
    recA.Open "SELECT * from 地址库", CurrentProject.Connection, adOpenStatic, adLockReadOnly
    recB.Open "SELECT * from 导入", CurrentProject.Connection, adOpenStatic, adLockOptimistic
    For i = 1 To recA.RecordCount
        recB.MoveFirst
        For j = 1 To recB.RecordCount
            门牌号 = GetNum(recB.Fields("地址"))
            If recB.Fields("地址") = recA.Fields("路名") Then
                recB.Fields("匹配站点") = recA.Fields("站点")
                recB.Update
            Else
                If recB.Fields("地址") Like "*" & recA.Fields("路名") & "*" Then    '导入表的地址包含地址库的路名
                    If 门牌号 >= recA.Fields("起始门牌号") And 门牌号 <= recA.Fields("截止门牌号") Then    '门牌号介于地址库中的当前范围
                        Select Case recA.Fields("奇偶性")
                        Case "奇"
                            If 门牌号 Mod 2 = 1 Then
                                recB.Fields("匹配站点") = recA.Fields("站点")
                                recB.Update
                            End If
                        Case "偶"
                            If 门牌号 Mod 2 = 0 Then
                                recB.Fields("匹配站点") = recA.Fields("站点")
                                recB.Update
                            End If
                        Case "全部"
                            recB.Fields("匹配站点") = recA.Fields("站点")
                            recB.Update
                        End Select
                    End If
                End If
            End If
            recB.MoveNext
        Next j
        recA.MoveNext
    Next i
End Sub



Top
sunrise 发表于：2019-08-21 16:35:00
经测试.
1、当导入表的行数过多时，附件中174行地址，就会出现如图中的错误。

点击下载此附件



Top
西出阳关无故人 发表于：2019-08-21 16:55:41

导入表的行数过多没有关系，而是类似“光复北路512号12A房（电话17701916033）”的信息被getnum变为了512121770916033，是一个超大的数字，就会出错。应该修改GetNum函数。正确的结果应该是512，就暂时按照“号”之前的数字进行提取门牌号。

Function GetNum(Exp As String) As Double
    Dim lntI As Long
    Dim strWord As String, Str As String
    For lntI = 1 To Len(Exp)
        strWord = Mid(Exp, lntI, 1)
        If strWord <> "号" Then  '看看当前字符是否为“号”
            If strWord Like "[0-9]" Then
                Str = Str & strWord
            End If
        Else
            Exit For '如果当前字符为“号”，就不再往右提取数字了。
        End If
    Next
    If Str = "" Then
        GetNum = 0
    Else
        GetNum = CDbl(Str)
    End If
End Function
尽管可以解决此类问题，但是你表中的数据，仍然还会出现其他情况。所以地址的规范是必要的。例如：朝天路崔府街32-40号，按照上面的提取方法，会得出3240号。又如：中山7路25号，会得出725号。



Top
sunrise 发表于：2019-08-22 11:25:01

谢谢大神指点.

1、改了上面的函数后，导入的表地址里没有“号” 字的地址就匹配不了。可不可以增加一个条件，当地址中没有门号，有4个汉字以上符合地名中4个字就匹配。

例！广州市越秀区西门口广场1000房。地址库中有“西门口广场”，这样就符合4个字以上。



Top
西出阳关无故人 发表于：2019-08-22 14:22:51
你自己规定，自己完善吧。

Top
sunrise 发表于：2019-08-24 09:36:34
好的，感谢啦！

Top
总记录：15篇  页次：1/1 9 1 :

Access软件网 版权所有 CopyRight 2006-2030
上海盟威软件有限公司 提供支持
沪ICP备12024966号-4