求助，学生各科成绩在不同工作簿中需要汇总到一个表中，vba代码怎么写，谢谢，

雨林0922 · 发表于 2022-9-12 13:46

小象啊啊发表于 2022-9-12 11:01
请参考附件

谢谢，能不能帮我写一个通用的，写好留下WX联系方式，运行成功一包华子（65）
1.需汇总的多个工作簿（最好支持100个工作簿）在同一个文件夹中。
2.每个工作簿只有一个工作表有数据，其他为空表。
3.每个工作表表格样式一样（第一行为标题，分别为：学号，姓名，XX成绩），
但各工作表行数不一样，如有的班级100人，有的200人，汇总时以学号为准，因为姓名有重名。
4.输出汇总为单独的工作簿且在当前路径下，表格第一行显示样式（学号，姓名，XX成绩，XX成绩……），后面行为具体对应内容。
5.vba代码是通用的，不针对具体表格，针对同一文件夹下的有相同样式的工作簿。

雨林0922 · 发表于 2022-9-12 14:22

3190496160 发表于 2022-9-12 13:39
说明给你的代码，你没有认真的研究测试，目前的代码就是通用的，根据学号来汇总，有多少个工作簿无所谓的

不好意思啊，我是完全不懂vba，只是平时用Excel的VLOOKUP函数用的太累了，想用vba提高工作效率，你的代码虽是通用的但我不知道怎么弄，

雨林0922 · 发表于 2022-9-12 15:12

3190496160 发表于 2022-9-12 13:39
说明给你的代码，你没有认真的研究测试，目前的代码就是通用的，根据学号来汇总，有多少个工作簿无所谓的

大佬，麻烦代码改一下吧，

micch · 发表于 2022-9-12 15:18

Sub Main_HUizongChengji()
'---select path
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the Folder where Files ar located"
.InitialFileName = ThisWorkbook.Path & ""
If .Show Then Mypth = .SelectedItems(1) Else Exit Sub
End With
On Error Resume Next
AppSet False
Dim wb As Workbook
Dim arr(1 To 99999, 1 To 6) '---jieguo shuzu
Set d = CreateObject("scripting.dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(Mypth).Files
If Not f.Name Like "~*" Then
Set wb = Workbooks.Open(f)
ar = wb.Sheets(1).UsedRange.Value
k = InStr("数学语文英语", Left(ar(1, 4), 2))
If k > 0 Then
k = (k \ 2) + 4
For i = 2 To UBound(ar)
code = CStr(ar(i, 3))
If Not d.exists(code) Then
r = r + 1
d(code) = r
arr(r, 1) = r
arr(r, 2) = ar(i, 2)
arr(r, 3) = code
End If
j = d(code)
arr(j, k) = Val(ar(i, 4))
Next
End If
wb.Close False
End If
Next
If r > 0 Then
With Sheet1
.UsedRange.Offset(1).ClearContents
.Range("a2").Resize(r, 6).Value = arr
End With
End If
AppSet True
End Sub
Public Sub AppSet(AppBl As Boolean)
With Application
.ScreenUpdating = AppBl
.DisplayAlerts = AppBl
.EnableEvents = AppBl
.AskToUpdateLinks = AppBl
If AppBl Then
.Calculation = xlCalculationAutomatic
Else
.Calculation = xlCalculationManual
End If
End With
End Sub

复制代码

xiangbaoan · 发表于 2022-9-12 15:53

本帖最后由 xiangbaoan 于 2022-9-12 16:34 编辑

测试.zip (46.51 KB, 下载次数: 23)

洋务德雷 · 发表于 2022-9-12 15:55

select * from [D:\360安全浏览器下载\附件20220912\数学成绩.xlsx].[sheet1$] union all
select * from [D:\360安全浏览器下载\附件20220912\英语成绩.xlsx].[sheet1$] union all
select * from [D:\360安全浏览器下载\附件20220912\语文成绩.xlsx].[sheet1$]

上面这是SQL语句，只需要复制，然后把语句内的文件路径修改成自己的路径就可以了。
关于数学成绩或者英语成绩等文件内的表格也要稍微修改一下。我给你上传了文件修改的样式，你可以看一下。
按照我给你录制的视频学习一下，以后碰到类似的问题都可以使用。
但是这种方法不可能同时连接100个文件，因为语句代码有限制，你也可以分词连接引入。
如果你有PQ的话那可以使用PQ更加自动化。
视频无法上传，你可以看一下网上视频课程。

雨林0922 · 发表于 2022-9-12 17:32

洋务德雷发表于 2022-9-12 15:55
select * from [D:\360安全浏览器下载\附件20220912\数学成绩.xlsx].[sheet1$] union all
select * from [ ...

谢谢，不过和我想要的效果不太一样，

雨林0922 · 发表于 2022-9-12 17:35

micch 发表于 2022-9-12 15:18

谢谢，能不能帮我写一个通用的，
1.需汇总的多个工作簿（最好支持多个工作簿）在同一个文件夹中。
2.每个工作簿只有一个工作表有数据，其他为空表。
3.每个工作表表格样式一样（第一行为标题，分别为：学号，姓名，XX成绩），
但各工作表行数不一样，如有的班级100人，有的200人，汇总时以学号为准，因为姓名有重名。
4.输出汇总为单独的工作簿且在当前路径下，表格第一行显示样式（学号，姓名，XX成绩，XX成绩……），后面行为具体对应内容。
5.vba代码是通用的，不针对具体表格，针对同一文件夹下的有相同样式的工作簿。

小象啊啊 · 发表于 2022-9-12 17:38

雨林0922 发表于 2022-9-12 13:46
谢谢，能不能帮我写一个通用的，写好留下WX联系方式，运行成功一包华子（65）
1.需汇总的多个工作簿（最 ...

请加微信 :mxytaian。可根据具体附件内容修改

雨林0922 · 发表于 2022-9-12 17:38

xiangbaoan 发表于 2022-9-12 15:53

谢谢，能不能帮我写一个通用的
1.需汇总的多个工作簿（最好支持多个工作簿）在同一个文件夹中。
2.每个工作簿只有一个工作表有数据，其他为空表。
3.每个工作表表格样式一样（第一行为标题，分别为：学号，姓名，XX成绩），
但各工作表行数不一样，如有的班级100人，有的200人，汇总时以学号为准，因为姓名有重名。
4.输出汇总为单独的工作簿且在当前路径下，表格第一行显示样式（学号，姓名，XX成绩，XX成绩……），后面行为具体对应内容。
5.vba代码是通用的，不针对具体表格，针对同一文件夹下的有相同样式的工作簿。

		自动登录	找回密码
密码			免费注册