excel 做数据源的经典问题征解

    dim oexcel as object
    dim obook as object
    dim osheet as object
    dim orange as object
    dim arrdata as variant
    dim r as integer, c as integer
    dim row as integer
    dim i as integer
    dim tmp as string, tmpdata as string
    
on error goto app_err:

    set oexcel = createobject（"excel.application")
    set obook = oexcel.workbooks.open（"c:\t.xls")
    set osheet = obook.worksheets（1)
    osheet.activate
     
    '获得已使用的行列
    r = osheet.usedrange.cells.rows.count
    c = osheet.usedrange.cells.columns.count
    
    '将内容读入数组
    redim arrdata（1 to r, 1 to c)
    '序号、编号、姓名、性别、年龄、单位
    arrdata = osheet.range（"a1").resize（r, c)
    
    '处理数据：
    for row = 2 to r
        '序号
        arrdata（row, 1) = row - 1
        '编号
        arrdata（row, 2) = format（arrdata（row, 2), "0000")
        '性别
        arrdata（row, 4) = iif（trim（format（arrdata（row, 4))) <> "", _
            arrdata（row, 4), "女")      '性别为空的都设置为“女”
        '年龄
        arrdata（row, 5) = replace（arrdata（row, 5), ".", "/")
        arrdata（row, 5) = replace（arrdata（row, 5), "、", "/")
        arrdata（row, 5) = replace（arrdata（row, 5), "-", "/")
        arrdata（row, 5) = format（arrdata（row, 5), "yy年mm月dd日")
        arrdata（row, 5) = datediff（"yyyy", arrdata（row, 5), date) '得到年龄
        '单位
        arrdata（row, 6) = replace（arrdata（row, 6), "一厂", "采油一厂") '自己根据需要添加
    next
    '相同记录保存在文本文件中
    tmpdata = "序号" & vbtab & "编号" & vbtab & "姓名" & vbcrlf
    for i = 2 to ubound（arrdata) - 1
        tmp = arrdata（i, 2) & vbtab & arrdata（i, 3)
        for row = i + 1 to ubound（arrdata)
            if arrdata（row, 2) & vbtab & arrdata（row, 3) = tmp then
                tmpdata = tmpdata & arrdata（row, 1) & vbtab & tmp & vbcrlf
            end if
        next row
    next i
    open "c:\tmp.txt" for output as #1
        print #1, tmpdata
    close #1
    
    '定义单元格格式
    oexcel.columns（"b:d").select
    oexcel.selection.numberformatlocal = "@"
    '写回excel表格
    osheet.range（"a1").resize（r, c).value = arrdata
    obook.save
    
    msgbox "ok"
    obook.close
app_exit:
    set osheet = nothing
    set obook = nothing
    oexcel.quit
    set oexcel = nothing
    exit sub
app_err:
    msgbox err.description
    resume app_exit