如何用多个关键字搜索并分类

aonly999

退货明细中的“退货理由”不标准，包含多余的信息，无法关联两个表。
用多个关键字搜索并分类，请问高手如何实现？谢谢！！

退货理由分类表：


退货明细表：


详见附件

aonly999

Private Sub Command0_Click()
    Dim cn As New adodb.Connection
    Dim rs_mx As New adodb.Recordset
    Dim rs_ly As New adodb.Recordset
    Dim sql As String
    Dim code As String
    Dim con1 As Variant
    Dim con2 As Variant
    Dim con3 As Variant
    Dim con4 As Variant
    Set cn = CurrentProject.Connection
    rs_mx.LockType = adLockOptimistic
    rs_ly.Open "select * from 理由分类", cn
    rs_ly.MoveFirst
    Do While Not rs_ly.EOF
        code = rs_ly!分类代码
        con1 = rs_ly!关键字1
        con2 = rs_ly!关键字2
        con3 = rs_ly!关键字3
        con4 = rs_ly!关键字4
        sql = "SELECT * FROM 退货明细 WHERE ("
        sql = sql & "(InStr([退货理由], '" & con1 & "') > 0) and "
        sql = sql & "(InStr([退货理由], '" & con2 & "') > 0) and "
        sql = sql & "(InStr([退货理由], '" & con3 & "') > 0) and "
        sql = sql & "(InStr([退货理由], '" & con4 & "') > 0) and "
        sql = sql & " isnull ([分类代码]) )"
        rs_mx.Open sql, cn
        Do While Not rs_mx.EOF
            rs_mx!分类代码 = code
            rs_mx.MoveNext
        Loop
        rs_mx.Close
        rs_ly.MoveNext
    Loop
    rs_ly.Close
    cn.Close
    Set rs_mx = Nothing
    Set rs_ly = Nothing
    Set cn = Nothing
    MsgBox "更新成功！"
End Sub

aonly999

这是完成后的