如何利用VBA解决学生综合素质评价问题

coollexcel

duquancai 发表于 2020-5-23 19:52
写完一个又写一个，不是为学习，而是为了帮你完成工作

我也关注你给其他人回帖，你也是这么回的。这是对伸手党的痛恨吧，谁愿意做伸手党啊，谁愿意别别人骂啊。学校的教师有几个人懂代码的，能编写函数公式已经很不错了，更何况学校也养不起代码高手，所以请高手请放过我。愿意帮助的，就看一看，帮一帮；不愿意帮助的，看看就算了，就让这个帖子沉下去。我相信好心人还是很多的。

donghui2363

Sub 学生汇总()
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    p = ThisWorkbook.Path & "\student\"
    sh = Dir(p & "*.xls")
     Do While sh <> ""
        Sql = Sql & "select * from [" & p & sh & "].[a1:j] union all "
        sh = Dir
     Loop
    Sql1 = Left(Sql, Len(Sql) - 10)
    Sql = "select 序号,学籍号,性别,班级,姓名,学业水平,身心健康,艺术素养,社会实践 from (" & Sql1 & ") where 评价类型='自评'"
    Sheets("自评").Range("a2").CopyFromRecordset cnn.Execute(Sql)
    Sql = "select 序号,学籍号,性别,班级,姓名,学业水平,身心健康,艺术素养,社会实践 from (" & Sql1 & ") where 评价类型='互评'"
    Sheets("互评").Range("a2").CopyFromRecordset cnn.Execute(Sql)
    cnn.Close
    Set cnn = Nothing
End Sub

coollexcel

donghui2363 发表于 2020-5-24 12:30
Sub 学生汇总()
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "Provider=Microsoft.ACE.OLEDB.1 ...

谢谢！模拟数据很成功。下午去学校收集学生的电子表，汇总一下。能否把教师汇总也弄一下。

donghui2363

Sub 老师()
Dim cnn As New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    p = ThisWorkbook.Path & "\teacher\"
    sh = Dir(p & "*.xls")
     Do While sh <> ""
        Sql = Sql & "select * from [" & p & sh & "].[a1:j] union all "
        sh = Dir
     Loop
    Sql = Left(Sql, Len(Sql) - 10)
    Sql = "select 序号,学籍号,性别,班级,姓名,学业水平,身心健康,艺术素养,社会实践 from (" & Sql & ") where 评价类型='教师评'"
    Sheets("教师评").Range("a2").CopyFromRecordset cnn.Execute(Sql)
    cnn.Close
    Set cnn = Nothing
End Sub

coollexcel

microyip 发表于 2020-5-24 08:10
又注册新号，重新免费定制开发？

大师，你看了您的一些帖子，您帮助了不少人。我也知道，谁也不喜欢伸手党。但您这样说，有意思吗？一个论坛注册几个号干嘛啊。伸手党们有时候也没有办法啊。我得到了帮助，我也会给我们的同仁们分享，让他们操作便捷啊。我干嘛冒着被大家骂的风险去注册一个小号，去做伸手党，去挨骂？我有插件可以搞定合并，我有函数公式去统计。我何苦到这里求助，被您说呢？还不是为了我的同仁们方便吗？大神们不屑一顾，还有小神们，好心人总是有的。所以，大神，请放过我。

coollexcel

donghui2363 发表于 2020-5-24 12:55
Sub 老师()
Dim cnn As New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Pr ...

老师汇总的没有验证成功，显示“用户定义类型未定义”

liufb203

应该是SQL的前期绑定，去看看这个http://club.excelhome.net/thread-1064171-1-1.html

liufb203

其实大家初学vba都是从伸手党过来的，只不过是大神们比我们先伸手。我不觉得伸手党有啥不好，至少也是在寻求一种解决问题的办法。office是一个实用型软件，尤其是VBA，只有见识到他的威力了才有更大的兴趣去学习。这次是你们说的伸手党，下次可能就照着代码改程序......从无到有不是一蹴而就的。

excelvlookup

写了民主评议表合并、汇总，别的可以仿照自己写

xiangbaoan

'顶老师一下吧，这里以 学籍号 为唯一值判断。
Option Explicit
Sub StudentAndTeacher() '学生数 或 老师数 不可超过 49 人，多了 不中！！！
Dim Cn As Object, d As Object, p$, f$, s$(2), t$(2), ar, br, i&, j&, k&, y&
For i = 1 To Sheets.Count
    Sheets(i).UsedRange.Offset(1).ClearContents
Next
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
s(0) = "SELECT 序号,学籍号,性别,班级,姓名,学业水平,身心健康,艺术素养,社会实践,评价类型"
p = ThisWorkbook.Path & "\student\"
f = Dir(p & "*.xls*")
Do While f <> ""
   s(1) = s(1) & " UNION ALL SELECT * FROM [" & p & f & "].[$A1:J]"
   f = Dir
Loop
s(2) = Mid(s(1), 11)
s(1) = s(0) & " FROM (" & s(2) & ") WHERE 评价类型='自评' ORDER BY 学籍号"
With Sheets("自评")
    .Range("A2").CopyFromRecordset Cn.Execute(s(1))
    t(0) = " FROM [" & .Name & "$A1:I" & .Cells(Rows.Count, 2).End(xlUp).Row & "] GROUP BY 学籍号"
    t(0) = "SELECT 学籍号,AVG(学业水平)*0.1,AVG(身心健康)*0.1,AVG(艺术素养)*0.1,AVG(社会实践)*0.1" & t(0)
    br = .Range("A1:I" & .Cells(Rows.Count, 2).End(xlUp).Row)
End With
s(1) = s(0) & " FROM (" & s(2) & ") WHERE 评价类型='互评' ORDER BY 学籍号"
With Sheets("互评")
    .Range("A2").CopyFromRecordset Cn.Execute(s(1))
    t(1) = " FROM [" & .Name & "$A1:I" & .Cells(Rows.Count, 2).End(xlUp).Row & "] GROUP BY 学籍号"
    t(1) = "SELECT 学籍号,AVG(学业水平)*0.5,AVG(身心健康)*0.5,AVG(艺术素养)*0.5,AVG(社会实践)*0.5" & t(1)
End With
s(1) = ""
p = ThisWorkbook.Path & "\teacher\"
f = Dir(p & "*.xls*")
Do While f <> ""
   s(1) = s(1) & " UNION ALL SELECT * FROM [" & p & f & "].[$A1:J]"
   f = Dir
Loop
s(2) = Mid(s(1), 11)
s(1) = s(0) & " FROM (" & s(2) & ") WHERE 评价类型='教师评' ORDER BY 学籍号"
With Sheets("教师评")
    .Range("A2").CopyFromRecordset Cn.Execute(s(1))
    t(2) = " FROM [" & .Name & "$A1:I" & .Cells(Rows.Count, 2).End(xlUp).Row & "] GROUP BY 学籍号"
    t(2) = "SELECT 学籍号,AVG(学业水平)*0.4,AVG(身心健康)*0.4,AVG(艺术素养)*0.4,AVG(社会实践)*0.4" & t(2)
    s(1) = "SELECT DISTINCT 学籍号,性别,班级,姓名 FROM [" & .Name & "$A1:E" & .Cells(Rows.Count, 3).End(xlUp).Row & "] ORDER BY 学籍号"
End With
Set d = CreateObject("Scripting.Dictionary")
With Sheets("民主评议汇总")
    .Range("B2").CopyFromRecordset Cn.Execute(s(1))
    ar = .Range("A1:I" & .Cells(Rows.Count, 2).End(xlUp).Row)
    For i = 2 To UBound(ar)
        d(CStr(ar(i, 2))) = i
    Next
    For k = 0 To UBound(t)
        br = Cn.Execute(t(k)).GetRows
        For j = 0 To UBound(br, 2)
            If d.Exists(CStr(br(0, j))) Then
                y = d(CStr(br(0, j)))
                For i = 1 To 4
                    ar(y, i + 5) = ar(y, i + 5) + br(i, j)
                Next
            End If
        Next
    Next
    .Range("A1:I" & .Cells(Rows.Count, 2).End(xlUp).Row) = ar
End With
Cn.Close
Set Cn = Nothing
Set d = Nothing
End Sub