一个对某一字段值排序的例子

zhengjialon

一个对某一字段值排序的例子
'******************************************************************************
'*   项目名称：   对表中的记录按某一字段进行排名                              
'*   过程函数名： 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
文件下载