根据标题汇总当前文件夹中的多个工作簿的数据

xiou1023

说明：

①当前文件夹中所有的工作簿都有几个汇总几个
②数据表中的行排序有可能是乱的，且人数不一致，甚至会存在重名的情况
③个别的数据表数据缺列，如期中15：只有班级 总分 姓名  生物
④汇总表的C1 的内容为变量，运用 输入框 输入学科名称，方便根据需要汇总不同的学科


求大神指点迷津

3190496160

VBA自学汇总当前文件夹表格.rar (96.1 KB, 下载次数: 14)

2023-1-20 15:39 上传

点击文件名下载附件

xiou1023

我的思路：
1.先在汇总表的C1 通过输入框 输入科目   如：生物
2.把每个数据表都按照 汇总表的 A1：D1  的值为自定义排序  行排序
3.按照 汇总表的标题（班级 姓名 生物<变量> 总分），复制粘贴各数据表的前四列到汇总表即可

ykcbf1100

多工作簿单科目汇总

3190496160

Sub VBA打开指定文件夹内所有Excel表格()
Application.ScreenUpdating = False
Set d = CreateObject("SCRIPTING.DICTIONARY")
    Dim huoqulujing$, myPath$, myFile$, WB As Workbook    '这个$ 是相当于定义字符串
    w = InputBox("请输入要分析学科名称，如生物： ", , "生物") '输入要分析学科名称，为自定义排序提供数据
    If w = "" Then End
    Range("C1").Value = w
    myPath = ThisWorkbook.Path & "\" '运用当前路径，即当前路径加一个反斜杠"
    myFile = Dir(myPath & "*.xls*") '依次找寻当前路径中的*.xls，或者xlsx文件
    [a1].CurrentRegion.Offset(1) = Empty
    ar = Range("a1:d10000")
    For j = 1 To UBound(ar, 2)
        If Trim(ar(1, j)) <> "" Then
            d(Trim(ar(1, j))) = j
        End If
    Next j
    n = 1
    Do While myFile <> "" '当指定路径中有文件时进行循环
        If myFile <> ThisWorkbook.Name Then '如果我们这个宏文件在需要处理的文件夹之中，这个判断就会跳过下面的操作
            Set WB = Workbooks.Open(myPath & myFile) '打开符合要求的文件
            With WB.Worksheets(1)
                br = .[a1].CurrentRegion
            End With
            WB.Close 0
            For i = 2 To UBound(br)
                If Trim(br(i, 1)) <> "" Then
                    n = n + 1
                    For j = 1 To UBound(br, 2)
                        lh = d(Trim(br(1, j)))
                        If lh <> "" Then
                            ar(n, lh) = br(i, j)
                        End If
                    Next j
                End If
            Next i
        End If
    myFile = Dir
    Loop
    [a1].Resize(n, UBound(ar, 2)) = ar
    Set WB = Nothing    '释放变量内存
    Set d = Nothing    '释放变量内存
Application.ScreenUpdating = True
  MsgBox "ok!"
End Sub

xiou1023

ykcbf1100 发表于 2023-1-20 15:06
多工作簿单科目汇总

感谢大神出手指点迷津，出现两个问题
1.汇总表的标题顺序为：班级 姓名 科目 总分（已修正）
2.重名的情况（待解决），如11班前两个姓名同名"十一1"，汇总表只保留了第2个的"十一1"的成绩

shiruiqiang

xiou1023 发表于 2023-1-20 15:44
感谢大神出手指点迷津，出现两个问题
1.汇总表的标题顺序为：班级 姓名 科目 总分（已修正）
2.重名的 ...

这样的话，建议数组提取了

ykcbf1100

xiou1023 发表于 2023-1-20 15:44
感谢大神出手指点迷津，出现两个问题
1.汇总表的标题顺序为：班级 姓名 科目 总分（已修正）
2.重名的 ...

已改，你再试一下。

xiou1023

ykcbf1100 发表于 2023-1-20 16:06
已改，你再试一下。

重名的问题还是没有解决

shiruiqiang

xiou1023 发表于 2023-1-20 17:11
重名的问题还是没有解决

你把这句话移上去就行了