【Access小品】词组的自动记忆与运用实例

todaynew

昨天写了一个常用语实例，在此基础上考虑可以进一步扩展运用，便写了一个词组的自动记忆与运用的实例，在这个例子中对常用语函数进行了改进。有些遗憾的是，本打算用控件的更改事件来写运用，可是折腾的不理想，最后改为了双击事件，于最初的设想略有偏差。





Public Function MYphrase(表名 As String, 字段名 As String, 频度 As Long, 长度 As Long) As String
'============================================================
'功能：获取表中对应字段的常用语
'参数：1、表名：表名称；
'      2、字段名：字段名称；
'      3、频度：词汇出现的最小次数
'      4、长度：词汇的最小长度
'示例：me.常用语.RowSource = MYphrase("物资表", "名称", 3, 2)
'============================================================
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long, j As Long, m As Long, n As Long
Dim str As String
Dim Maxlen As Long
Dim Myfname As String
Dim MyArray(), MyA()
Maxlen = DMax("len([" & 字段名 & "])", 表名)
m = 0
For i = 0 To Maxlen - 长度 - 1
    Myfname = "left(" & 字段名 & ", Len(" & 字段名 & ") - " & i & ")"
    ssql = "SELECT " & Myfname & " As 字段" & ", Count(" & Myfname & ") AS 计数 "
    ssql = ssql & " FROM " & 表名
    ssql = ssql & " WHERE len(" & 字段名 & ")>=" & 长度 + i
    ssql = ssql & " GROUP BY " & Myfname
    ssql = ssql & " HAVING Count(" & Myfname & ")>=" & 频度
    rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    For j = 1 To rs.RecordCount
        If i = 0 Then
            m = m + 1
            ReDim Preserve MyArray(1 To 2, 1 To m)
            MyArray(1, m) = rs("字段")
            MyArray(2, m) = rs("计数")
        Else
            For n = UBound(MyArray, 2) To 1 Step -1
                If InStr(MyArray(1, n), rs("字段")) > 0 And MyArray(2, m) < rs("计数") Then
                    m = m + 1
                    ReDim Preserve MyArray(1 To 2, 1 To m)
                    MyArray(1, m) = rs("字段")
                    MyArray(2, m) = rs("计数")
                    Exit For
                End If
            Next
        End If
        rs.MoveNext
    Next
    rs.Close
Next
CurrentDb.Execute "CREATE TABLE 临时表 (词组 Char(50))"
rs.Open "临时表", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To UBound(MyArray, 2)
    rs.AddNew
    rs("词组").Value = MyArray(1, i)
    rs.Update
Next
rs.Close
ssql = "SELECT 词组 FROM 临时表 ORDER BY 词组;"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs.RecordCount
    str = str & rs("词组").Value & ";"
    rs.MoveNext
Next
rs.Close
DoCmd.DeleteObject acTable, "临时表"
MYphrase = str
End Function

xxk8077

学习学习

pyh512

学习学习了

GOODWIN

学习一下

nncchh

分享了

nncchh

学习

szyewj

学习学习

li08hua

学习学习！

szyewj

学习，感谢分享

dddd042821

谢谢分享