ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: 沉潜

[求助] 较难的成绩统计代码求助

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2012-6-19 16:19 | 显示全部楼层
我以前找的一段代码:
Sub 导入成绩1()
    Dim SrcBook As Workbook
    Dim SrcSht As Worksheet
    Dim ws As Worksheet
    Dim myName As String
    Set ws = ActiveSheet
    myName = ws.Name
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets
        f = Application.GetOpenFilename("")
    End With
    On Error Resume Next
    If f < " " Then Exit Sub
    If f >= " " Then
        Sheet1.Cells(2, 1).Resize(Rows.Count - 1, 13).ClearContents
        Set SrcBook = Workbooks.Open(f)
        For Each SrcSht In SrcBook.Worksheets
            SrcSht.Range("A1:IV" & SrcSht.Range("A65536").End(xlUp).Row).Copy
            Workbooks(1).Worksheets(myName).Activate
            Range("A65536").End(xlUp).offset(0, 0).PasteSpecial
            Application.CutCopyMode = False
        Next
        SrcBook.Close
        Set SrcBook = Nothing
    End If
    Application.ScreenUpdating = True
End Sub

TA的精华主题

TA的得分主题

发表于 2012-6-19 18:02 | 显示全部楼层
本帖最后由 mjzxlmg 于 2012-6-19 18:05 编辑
lzqlaj 发表于 2012-6-19 16:18
成绩导入运行不了。

你的是2003吧,我用的2010,用的ADO代码是新的,忘记改了。

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source= " & FileName & ""


[code=vb]Sub 导入成绩()         '请把导入数据工作簿的成绩数据工作表命名为:成绩源
    Dim FileName, cnn As Object
    FileName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 1, "导入Excel工作表数据")
    If FileName <> False Then
        Set cnn = CreateObject("ADODB.Connection")
            cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source= " & FileName & ""
            With Sheet1
                .Cells(2, 1).Resize(Rows.Count - 1, 13).ClearContents
                .Cells(2, 1).CopyFromRecordset cnn.Execute("[成绩源$a1:m65536]")
            End With
        cnn.Close
        Set cnn = Nothing
        MsgBox "成绩数据导入成功,请查看! ", 64, "提示:"
     Else
        MsgBox "没有选择文件!", vbCritical
    End If
End Sub
[/code]

TA的精华主题

TA的得分主题

发表于 2012-6-19 21:21 | 显示全部楼层
mjzxlmg 发表于 2012-6-19 18:02
你的是2003吧,我用的2010,用的ADO代码是新的,忘记改了。

cnn.Open "Provider=Microsoft.Jet.OLEDB. ...

是2003,以前一直以为是忘了引用ADO.

TA的精华主题

TA的得分主题

发表于 2012-6-19 21:24 | 显示全部楼层
lzqlaj 发表于 2012-6-19 21:21
是2003,以前一直以为是忘了引用ADO.

直接引用数据,最快的就是ADO了。用GETOBJECT、GETOPEN速度较慢。

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-6-22 07:08 | 显示全部楼层
mjzxlmg 发表于 2012-6-19 09:27

老师您好,能否还添加个导出(另存)年级科目选择,像[打印选择]一样,将选择中的年级和科目全部导出到一个表中啊,谢谢你了

TA的精华主题

TA的得分主题

发表于 2012-7-14 18:07 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2012-7-16 08:29 | 显示全部楼层
hedgehog93 发表于 2012-7-14 18:07
没回信了?

成绩求助.rar (81.02 KB, 下载次数: 101)

TA的精华主题

TA的得分主题

发表于 2012-7-16 09:07 | 显示全部楼层
本帖最后由 hedgehog93 于 2012-7-16 11:41 编辑
mjzxlmg 发表于 2012-7-16 08:29

谢谢,看了一下,你这个程序更加完善了,可以一下生成导出所有科目,但是有点疑问,无法自动判断科目多少,比如我还多了几科,程序加载的时候没有显示完全,当然改一改程序里个别数字就可以实现,但我觉得最好能自动判断;另外你的“设置”表里隐藏了其它单元格,我想了很多办法,居然没有把其它隐藏了的找回来,呵呵,因为还要加其它一些科目,所以。

另外能不能麻烦高手再帮我改一下这个程序。我不需要“部别”,“年级”,“期”,差生人数,差生率,分段段,还有最高分,最低分。另外优生人数,优生率也有些不同,我们需要各班优生人数是全年级前20%中各班的人数,优生率是各班优生人数除以全年级的。我自己试着研究了一下,整了两天,都没有整出我需要的效果来,实在不好意思了,希望高手能帮帮忙。导出也希望能导出所有科目的。
附:我做的一个。 成绩求助.zip (94.74 KB, 下载次数: 42)

TA的精华主题

TA的得分主题

发表于 2012-7-16 15:25 | 显示全部楼层
hedgehog93 发表于 2012-7-16 09:07
谢谢,看了一下,你这个程序更加完善了,可以一下生成导出所有科目,但是有点疑问,无法自动判断科目多少 ...

捕获.JPG

TA的精华主题

TA的得分主题

发表于 2012-7-16 17:27 | 显示全部楼层
mjzxlmg 发表于 2012-7-16 15:25

可能中了宏病毒了,怎么办呢?
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 08:22 , Processed in 0.051847 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表