Office中国论坛/Access中国论坛

标题: 【Access小品】词组的自动记忆与运用实例 [打印本页]

作者: todaynew 时间: 2010-1-2 20:54
标题: 【Access小品】词组的自动记忆与运用实例
本帖最后由 todaynew 于 2010-1-3 07:09 编辑

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

[attach]41070[/attach]

[attach]41071[/attach]

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 时间: 2010-1-2 21:01
todaynew楼主的帖子都要收藏。
支持。

作者: ycxchen 时间: 2010-1-3 09:20
又一个好作品，下载学习！

作者: 5988143 时间: 2010-1-4 08:44
好作品,学习一下

作者: su_xx 时间: 2010-1-4 10:59
你是我学习的榜样,谢了!

作者: aslxt 时间: 2010-1-4 18:15
值得学习学习

作者: todaynew 时间: 2010-1-5 13:41
谢谢领导和同志们的鼓励。

作者: asklove 时间: 2010-1-5 15:01
todaynew 的小品，没话说，收藏!

作者: dragonszr 时间: 2010-1-5 22:01
都是JP,顶上去!

作者: leijiqiang 时间: 2010-1-11 08:40
下下下

作者: c101 时间: 2010-1-11 09:07
謝謝分享

作者: dddd042821 时间: 2010-7-28 16:34
谢谢分享

作者: szyewj 时间: 2010-8-22 13:49
学习，感谢分享

作者: li08hua 时间: 2010-9-11 02:06
学习学习！

作者: szyewj 时间: 2011-5-11 00:48
学习学习

作者: nncchh 时间: 2015-5-25 22:33
学习

作者: nncchh 时间: 2015-5-25 22:33
分享了

作者: GOODWIN 时间: 2015-7-9 13:40
学习一下

作者: pyh512 时间: 2016-5-19 21:11
学习学习了

作者: xxk8077 时间: 2023-2-22 19:32
学习学习

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)