【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

chaojianan

todaynew楼主的帖子都要收藏。
支持。

ycxchen

又一个好作品，下载学习！

5988143

好作品,学习一下

su_xx

你是我学习的榜样,谢了!

aslxt

值得学习学习

todaynew

谢谢领导和同志们的鼓励。

asklove

todaynew 的小品，没话说，收藏!

dragonszr

都是JP,顶上去!

leijiqiang

下下下