再讲ＡＤＯ

zhouzhongchi

hyefeifei 发表于 2016-5-6 14:33
你可以安装server2003 32位版+sql2000，应该可以装上

谢谢您的回复！
我的电脑硬件好像不支持虚拟的嘛

zhouzhongchi

hyefeifei 发表于 2016-5-6 14:33
你可以安装server2003 32位版+sql2000，应该可以装上

楼主的意思是直接在当前系统下安装server 2003+sql2000?暂时不去考虑虚拟。
冒昧的问下，能否远程帮助下？

hyqzzs

收藏学习，谢谢楼主

aierb

支持一下。

hyefeifei

Recordset  Fields 集合的 Append 方法 　　大家看下图，左图为原始数据，右图为要求得到的结果。 　　要求如下（班组为临时排除在外）： 　　一、按体重进行总排序。 　　二、按男女进行排序。 　　三、按班组进行排序 　　四、原来的顺序不变，排序结果放在最后3列 　　如果后台是用数据库的话（如mysql,sqlserver等），这个要求很容易实现。 　　但现在只是给定了Excel的Weight表，让你达到右边的结果，该如何做呢？ 　　我相信搜一下坛里会有不少方法。 　　但因为要讲ADO，所以今天我们用Fields集合的append方法，建一个recordset对象，来实现要求的结果。 　　且看下面的代码： 　　Dim rst as object 　　Set rst=CreateObject(“adodb.recordset”) 　　Rst.open strsql,conn 　　上面的代码创建并打开了一个recordset对象，conn是一个连接，strsql是sql语句或表名存储过程名等。 　　那么，我们能不能不要strsql和conn，而打开一个recordset对象呢？这是可以的，这就要用到Fields的append方法，这个方法的语法如下： rst.Fields.Append 字段名 , 数据类型 , [字段大小]（棕括号内为可选参数） 复制代码 　　举个例子： rst.Fields.Append "ID" , adInteger 复制代码 　　这就创建了一个名为ID，数据类型为长整型的字段 　　再举一例　 rst.Fields.Append "cname" , adVarWChar , 10 复制代码 　　这就创建了一个名为cname，数据类型为最长10个字符的Unicode字符串 　　如果有人不了解ADO的数据类型，请翻到本贴的23楼，我在那里贴了全的。当然你也可以百度。 　　我们看看下面一段代码： Sub Createrst() 　　Dim rst As Object 　　Set rst=CreateObject("adodb.recordset") 　　With rst 　　'----------------------------------------------- 　　       '添加2个字段如下：              .Fields.Append "ID" , adInteger              .Fields.Append "cname" , adVarWChar , 10 　　'-----------------------------------------------              .Open                                             '打开recordset对象 　　'----------------------------------------------- 　　      '以下添加3条记录 　　      .addnew Array(0,1) , Array(1,"赵构") 　　      .addnew Array(0,1) , Array(2,"李刚") 　　      .addnew Array(0,1) , Array(3,"刘义隆") 　　'-----------------------------------------------              .movefirst                                        '当你填加完记录时，当前记录定位                           在最后一条记录上，所以你要取回全部数据，须把游标移到最前 　　EndWith 　　'----------------------------------------------- 　　Range("a2").CopyFromRecordset rst          '取回数据 End Sub 　　当你执行程序后，会得到如下结果：                          　　程序代码见注释，就不多解释了。 　　那么如何利用它来实现我们一开始提到的目标呢？

hyefeifei

接着讲： 　　首先我们用append方法建一个recordset对象，这个对象都需要哪些字段呢？ 　　1.ID字段，这个字段的内容为1234……，保存表的原始顺序，因为排序后会打乱顺序，所以最后可以对这个字段排序，以恢复原始顺序。 　　2.sec字段，这个字段取表性别的值，要根据它分组排序。 　　3.class字段，这个字段取表班组的值，要根据它分组排序。 　　4.weighte字段，这个字段取体重的值，因为它是排序的依据。 　　5.还需要3个字段rRank,gRank,bRank分别存放全体名次，性别名次，班组名次 　　程序代码如下： Sub Createobjrst()     Dim Conn As Object, rst As Object, objRst As Object, strSQL$, k&     '---------------------------------------------------------------------------------------     '以下代码建立连接     Set Conn = CreateObject("ADODB.Connection")     Set rst = CreateObject("ADODB.Recordset")     Set objRst = CreateObject("ADODB.Recordset")     Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;Imex=1;Hdr=yes';Data Source=" & ThisWorkbook.FullName    '---------------------------------------------------------------------------------------     '从Weight取回数据到rst     strSQL = "Select * from [Weight$b2:e] where 姓名<>'' and 班组<>'临时'"     rst.Open strSQL, Conn     '---------------------------------------------------------------------------------------     With objRst         .Fields.Append "ID", adInteger                   '此字段为保留原始顺序         .Fields.Append "sex", adVarWChar, 1          '此字段为分组依据，以便进行按性别排序         .Fields.Append "class", adVarWChar, 10      '此字段为分组依据，以便进行按班组排序         .Fields.Append "Weight", adSingle              '此字段为排序依据         .Fields.Append "cRank", adInteger              '存放整体排序结果         .Fields.Append "gRank", adInteger             '存放按性别排序结果         .Fields.Append "bRank", adInteger             '存放按班组排序结果         .Open     '---------------------------------------------------------------------------------------     '以下程序把数据放入objRst中 这里是先用rst把数据取回，再把数据传给objRst，当然你可以用数组把数据传给objRst         Do While Not rst.EOF             k = k + 1             .addnew Array(0, 1, 2, 3), Array(k, rst!性别, rst!班组, rst!体重)    '用addnew方法添加记录，addnew方法接受2个数组                                                                                                 '参数，第一个数组为字段名，第二个数组为相应的字段值             rst.MoveNext         Loop         .movefirst     End With     '---------------------------------------------------------------------------------------     '最终的程序只须把最终结果取回即可，不需要把中间步骤的结果返回工作表，这里只是为演示     With Sheet3         .Range("a1:g1") = Array(objRst(0).Name, objRst(1).Name, objRst(2).Name, _                                 objRst(3).Name, objRst(4).Name, objRst(5).Name, objRst(6).Name)     '取表头         .Range("a2").CopyFromRecordset objRst                                                                   '取回数据     End With End Sub 　　执行程序后，我们看一下得到的表： 　　 　　待续……

hyefeifei

继续： 　　有了上一讲的表，简单说一下思路： 　　一、我们先对Weight字段排序，使用objrst.sort=”Weight Desc”方法。 　　再根据排序结果计算名次，把计算结果写入cRank字段。如果计算？因为简单且不是ado内容，就不讲了。 　　二、我们再对Sex字段使用过滤方法：objrst.filter=”sex=’男’”，这样就把男性筛选出来了，此时再重复步骤一，不同的是这时要把结果写入gRank字段。 　　三、对sex字段女过滤，对class字段一组二组过滤，与步骤二相同，就不再说了。 　　当然，实际操作的时候，过滤条件要利用循环。 　　四、当全部名次计算完后，再全体安id号排序，以恢复原始顺序。 　　同时不要忘了，因为前面使用了过滤，而最终要取回所有结果，所以要清除过滤器（filter=0）。 　　五、把结果返回工作表。 　　完整程序如下： Sub adoSort()     Dim Conn As Object, rst As Object, objRst As Object, strSQL$, k&, tmp!, arr     '---------------------------------------------------------------------------------------     '以下代码建立连接     Set Conn = CreateObject("ADODB.Connection")     Set rst = CreateObject("ADODB.Recordset")     Set objRst = CreateObject("ADODB.Recordset")     Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;Imex=1;Hdr=yes';Data Source=" & ThisWorkbook.FullName     '---------------------------------------------------------------------------------------     '从Weight取回数据到recordset对象     strSQL = "Select * from [Weight$b2:e] where 姓名<>'' and 班组<>'临时'"     rst.Open strSQL, Conn     ThisWorkbook.Worksheets("Weight").Range("g3").CopyFromRecordset rst    '取回数据到相应位置     rst.movefirst                                     '当你用copyfromrecordset取回数据后，当前记录移至最后，因为你后面还要用rst给objrst添加记录，所以需要把当前记录移至首位     '---------------------------------------------------------------------------------------     '建一个临时的recordset对象进行排序，此对象有id字段为递增字段，排序后，恢复以此字段排序     '以使原表顺序不变     With objRst         .Fields.Append "ID", adInteger                  '此字段为保留原始顺序         .Fields.Append "sex", adVarWChar, 1         '此字段为分组依据，以便进行按性别排序         .Fields.Append "class", adVarWChar, 10     '此字段为分组依据，以便进行按班组排序         .Fields.Append "Weight", adSingle             '此字段为排序依据         .Fields.Append "rRank", adInteger             '存放排序结果         .Fields.Append "gRank", adInteger            '存放按性别排序结果         .Fields.Append "bRank", adInteger            '存放按班组排序结果         .Open locktype:=adLockBatchOptimistic     '---------------------------------------------------------------------------------------     '以下程序把数据放入objRst中 这里是先用rst把数据取回，再把数据传给objRst，当然你可以用数组把记录传给objRst         Do While Not rst.EOF             k = k + 1             .addnew Array(0, 1, 2, 3), Array(k, rst!性别, rst!班组, rst!体重)             rst.MoveNext         Loop     '---------------------------------------------------------------------------------------     '以下程序全体排序         .Sort = "Weight Desc"                       '体重降序排序         k = 0                                               '初始化变量         tmp = 0                                           '初始化变量         Do While Not .EOF             If !Weight.Value <> tmp Then       '只有当下一个体重不等于上一个部分时，名次才加1                 k = k + 1                 tmp = !Weight.Value                '记录当前体重，以与下一个体重比较             End If             !rRank.Value = k                          '赋与名次             .MoveNext         Loop     '---------------------------------------------------------------------------------------         rst.Close                                                             '数据放入objRst后，使命完成，关闭对象         strSQL = "Select distinct 性别 from [Weight$b2:d]" '提取不重复性别，为性别内排序做准备,如果你用数据取代rst的话，可以用字典取不重复值         rst.Open strSQL, Conn     '---------------------------------------------------------------------------------------     '以下程序对按性别排序         .Sort = "Weight Desc"         Do While Not rst.EOF                                 'rst内存有不重复性别             .Filter = "sex='" & rst!性别.Value & "'"    '循环rst记录，依次以性别过滤objRst             k = 0             tmp = 0             Do While Not .EOF                 If !Weight.Value <> tmp Then                     k = k + 1                     tmp = !Weight.Value                 End If                 !gRank.Value = k                 .MoveNext             Loop             rst.MoveNext         Loop    '---------------------------------------------------------------------------------------         rst.Close                                                                                                 '数据放入objRst后，使命完成，关闭对象         strSQL = "Select distinct 班组 from [Weight$b2:d] where 班组<>'临时'"       '提取不重复性别，为性别内排序做准备         rst.Open strSQL, Conn    '---------------------------------------------------------------------------------------     '以下程序对按班组排序         .Sort = "Weight Desc"         Do While Not rst.EOF                                                                    'rst内存有不重复性别             .Filter = "class='" & rst!班组.Value & "'"                                      '循环rst记录，依次以班组过滤objRst             k = 0             tmp = 0             Do While Not .EOF                 If !Weight.Value <> tmp Then                     k = k + 1                     tmp = !Weight.Value                 End If                 !bRank.Value = k                 .MoveNext             Loop             rst.MoveNext         Loop     '---------------------------------------------------------------------------------------         .Filter = 0                                                                                   '排序完成，清除过滤器         .Sort = "ID"                                                                                '恢复原始顺序         arr = .GetRows(Fields:=Array("rRank", "grank", "brank"))                '把总名次，性别名次，班组名次放入数组     End With     '把结果写回工作表区域     ThisWorkbook.Worksheets("Weight").Range("k3"). _                                            Resize(UBound(arr, 2) + 1, UBound(arr, 1) + 1) = Application.Transpose(arr) End Sub 　　因代码比较多，所以把附件提供给大家参考： ado排序.rar (33.73 KB, 下载次数: 77) 2016-5-8 11:38 上传 点击文件名下载附件

看见星光

感谢老师的讲解，已加精。

feiren228

学习，感谢楼主的耐心讲解。

goldowl2011

MARK.THANKS A LOT.GOOD CODES.