批处理之家 - Powered by Discuz! Board

标题: [问题求助] VBS脚本如何在统计 excel 中某人名下有多少种不同数字？ [打印本页]

作者: CrLf 时间: 2012-8-11 17:59 标题: VBS脚本如何在统计 excel 中某人名下有多少种不同数字？

本意是想写个 vbs 统计 Name 列下的 aaa 和 bbb（仅作示例，实际不知道该列具体有多少人）在 Num 列下出现了多少个不同的数字，比如原表格为：

Num        Name
1        aaa
1        aaa
2        bbb
1        aaa
5        bbb
4        bbb
1        aaa
4        aaa
3        aaa
3        bbb
复制代码

希望得到的结果是：

aaa 有 3 个不同数字：1、3、4
bbb 有 4 个不同数字：2、3、4、5
复制代码

提供测试 xls 文件：

------------------------------------------------------------------------------------------
本想先排序以便判断，可是不知应如何按照录制的 vba 转为 vbs...
录制的 vba 宏如下：

 Macro1 Macro
 宏由 User 录制，时间: 2012/8/11

    ChDir "C:\tesst1"
    Workbooks.Open Filename:="C:\tesst\test.xls"
    Sheets("Sheet1").Select
    Range("A2:B11").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
        xlSortNormal, DataOption2:=xlSortNormal
End Sub
复制代码

改写的 vbs 如下：

Set oExcel= CreateObject("Excel.Application") 
oExcel.Visible = True
With oExcel
    .Workbooks.Open "C:\tesst\test.xls"
    .Sheets("Sheet1").Select
    .Range("A2:B11").Select
    .Selection.Sort .Range("B2"),xlAscending,.Range("A2"),xlAscending,_
    xlGuess,1,False,xlTopToBottom,xlPinYin,xlSortNormal,xlSortNormal
    .Quit
End With
复制代码

运行后产生了错误信息提示：

类 Range 的 Sort 方法无效

不知道应如何解决，盼指点

作者: Demon 时间: 2012-8-11 22:11

给个半成品。

Const Source = "D:\test.xls"

'Author: Demon
'Website: http://demon.tw
'Date: 2012/8/11

Set con = CreateObject("ADODB.Connection")
set rs1 = CreateObject("ADODB.Recordset")
set rs2 = CreateObject("ADODB.Recordset")

con.Provider = "Microsoft.Jet.OLEDB.4.0"
con.ConnectionString = "Data Source=" & Source &_
";Extended Properties=Excel 8.0;"
con.Open
rs1.Open "SELECT DISTINCT Name FROM `Sheet1$`", con

Do Until rs1.EOF
name = rs1.Fields("Name").Value
WScript.Echo name
rs2.Open "SELECT DISTINCT Num FROM `Sheet1$` WHERE Name = " & SingleQuoted(name), con
Do Until rs2.EOF
WScript.Echo rs2.Fields("Num").Value
rs2.MoveNext
Loop
rs2.Close
rs1.MoveNext
WScript.Echo ""
Loop

Function SingleQuoted(s)
SingleQuoted = "'" & s & "'"
End Function

作者: CrLf 时间: 2012-8-12 02:17

回复 2# Demon

速度相当快，多谢指点！
第一次看到，原来 xls 也可以当数据库来操作...收藏了，有空得学一下数据库。

欢迎光临批处理之家 (http://www.bathome.net/)