求能按年级自动汇总各校六个年级学生考号的VBA代码

牛爱兵

求助问题：我们这里使用网上阅卷，考前需要将各校学生的考号信息导入系统，但导入时要求按年级导入，因此我需要将12个学校每个学校6个年级的学生考号信息汇总在一个文件中，每次都需要花费大半天时间，而且看的眼疼，复制粘贴的手疼。想在文件“各校六个年级考号汇总”中求一篇VBA代码，能够自动将每个学校6个年级的学生考号信息按年级汇总在这个文件中（汇总后每个年级只需要一行标题就行了），谢谢。

3190496160

类似的贴子很多，搜搜看看嘛

山菊花

供参考。

ericxzhou

Sub WorkbookSummary()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim wksSheet As Worksheet
    Dim strPath As String
    Dim avntFileNames() As Variant
    Dim avntSheetNames() As Variant
    Dim objFso As Object
    Dim objFolder As Object
    Dim objFiles As Object
    Dim objFile As Object
    i = 1
    avntSheetNames() = Array("一年级", "二年级", "三年级", "四年级", "五年级", "六年级")
    strPath = ThisWorkbook.Path
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.getfolder(strPath)
    Set objFiles = objFolder.Files
    ReDim avntFileNames(1 To objFiles.Count - 2)
    For Each objFile In objFiles
        If Not Right(objFile.Name, 4) = "xlsm" Then
            avntFileNames(i) = objFile.Name
            i = i + 1
        End If
    Next
    For j = 1 To UBound(avntFileNames)
        Workbooks.Open strPath & "\" & avntFileNames(j)
        For k = 0 To 5
            Workbooks(avntFileNames(j)).Activate
            Set wksSheet = Sheets(avntSheetNames(k))
            wksSheet.Select
            If wksSheet.Range("a2").Value <> "" Then
                With wksSheet.Range("a1").CurrentRegion
                    .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy
                End With
                ThisWorkbook.Activate
                Sheets(avntSheetNames(k)).Select
                Range("a" & Range("a1").CurrentRegion.Rows.Count + 1).Select
                ActiveSheet.Paste
            End If
       Next k
        Range("a1").Copy
        Workbooks(avntFileNames(j)).Close savechanges:=False
    Next j
End Sub
注意把代码放入汇总文件中，汇总文件需和各校考号文件放在同一文件夹中，汇总文件各表头自行添加，汇总文件需存为xlsm文件。另外你文件夹里的“节张小学考号”是错误文件无法打开。

牛爱兵

山菊花 发表于 2021-3-31 12:46
供参考。

经过反复测试，两个VBA都能准确的对各校考号进行汇总，最实用的是能“自定义学校排序”这个，不仅能自定义学校排序，而且能统计各校各年级的人数，非常实用精准。感谢版主能在百忙中抽出时间帮我，而且能够设身处地的考虑到我的实际需求，感恩帮助，祝您开心快乐每一天！

牛爱兵

ericxzhou 发表于 2021-3-31 14:50
Sub WorkbookSummary()
    Dim i As Integer
    Dim j As Integer

首先感谢帮助，按照您的方法操作，提示“下标越界”，自动打开了世纪星学校的文件，光标停在了右侧的I列，好象多了一列，我不懂，反正是不能正常运行，特此告知，共同学习进步。

ericxzhou

牛爱兵 发表于 2021-3-31 19:52
首先感谢帮助，按照您的方法操作，提示“下标越界”，自动打开了世纪星学校的文件，光标停在了右侧的I列 ...

问题出在：汇总文件需要手动建立6个工作表，各命名为“一年级”至“六年级”，另外代码不能放在“本工作簿”里面，应该插入一个模块，放在模块里面。各工作表的表头也需手动添加。

牛爱兵

好象是按你说的做了，可是还是不行，提示“400”，另外，“代码不能放在“本工作簿”里面，应该插入一个模块，放在模块里面”，怎样插入模块？能否制做好，让我看看？

ericxzhou

牛爱兵 发表于 2021-4-1 17:46
好象是按你说的做了，可是还是不行，提示“400”，另外，“代码不能放在“本工作簿”里面，应该插入一个模 ...

我手机无法上传附件，网上搜搜如何插入excel VBA模块，很容易的

牛爱兵

ericxzhou 发表于 2021-4-1 17:50
我手机无法上传附件，网上搜搜如何插入excel VBA模块，很容易的

通过在网上搜怎样插入模块，在模块中粘贴了你写的代码，然后插入按纽链接代码，成功了，学习了，多谢，以后有问题再请教你。