Office中国论坛/Access中国论坛

标题: 一个对某一字段值排序的例子 [打印本页]

作者: zhengjialon 时间: 2002-11-6 20:19
标题: 一个对某一字段值排序的例子
一个对某一字段值排序的例子
'******************************************************************************
'* 项目名称：对表中的记录按某一字段进行排名
'* 过程函数名： PaiMinChi  类型：Function
'*
'* 版权所有： Access中国首页（http://www.office-cn.net）
'* 作者：    zhengjialon(57162399@163.com)
'*
'* 参数：strTableName(String) 用于被排名表的名称
'*       strFieldName(String) 用于被排名字段的名称
'*       strFieldName1(String) 用于排名后填入名次的字段
'* 返回：本函数不返回值
'*
'* 完成时间： 2002年11月6日
'* 修改时间：
'*
'*
'* 说明：1.本函数是用ADO，因此必须用ACCESS2000或以上版本。
'*       2.本函数会一次性更改表里的strFieldName1参数的值，请注意要确定其中
'*          的值已经无用可以被替代。
'*       3.ACCESS2000+WIN2000SERVER和ACCESS2000+WIN98已通过。
'*       4.如果发现错误或有更好的建议和意见请发E-mail给我。
'*       5.本函数原理是：对表（strTableName）按某一字段（strFieldName）进行 *
'*          排序后才将数字从小到大写到另一字段（strFieldName1）对于相同的值  *
'*          写相同的编号。                                                 *
'******************************************************************************

Public Function PaiMinChi(strTableName As String, strFieldName As String, strFieldName1 As String)
On Error GoTo PaiMinChi_Err:
Dim I As Long
Dim con As Object
Dim rs As Object
Dim stsql As String
Static same As Long

Set con = Application.CurrentProject.Connection
stsql = "SELECT * FROM "
stsql = stsql + strTableName
stsql = stsql + " ORDER BY " & strTableName & "." & strFieldName & " desc;"

Set rs = CreateObject("ADODB.Recordset")
rs.Open stsql, con, 3, 3

'如果表中没有记录则提示。
If (rs.EOF) Then
      MsgBox "表中没有一条记录，已终止。", 48, "

aiMinChi"
Else
      While (Not (rs.EOF))
         If rs(strFieldName) <> same Then
            I = I + 1
            same = rs(strFieldName)
         End If
         rs(strFieldName1) = I
         rs.MoveNext
      Wend
End If

'关闭打开的记录集
rs.Close
Set rs = Nothing
Set con = Nothing
PaiMinChi_Exit:
Exit Function

PaiMinChi_Err:
'提醒表不可以以独占方式打开(在MDB中)
If Err.Number = -2147467259 Then
      MsgBox "该表已被以独占方式打开,请关闭此表", 48, "

aiMinChi"
      rs.Close
      con.Close
      Resume PaiMinChi_Exit
'其它错误
Else
      MsgBox Err.Description & Err.Number, 48, "

aiMinChi"
      rs.Close
      con.Close
      Resume PaiMinChi_Exit
End If

End Function
文件下载

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