汇总不同列不同名称数据

尼古丁vs乙醇

如附件所示，附件中有“北京”，“上海”，“广州”三个文件，现在想将部分数据（姓名，专业，年龄）累计到“汇总表”文件中，但是“北京”，“上海”，“广州”三个文件的相应内容是在不同的列上的（如专业：北京在E列，上海在H列，广州在G列）；由于各地区本身的提报模版不同，因此提报的表头有区别（如广州的姓名栏为name，而年龄栏为age，并且缺少了其他表格需要的学号和出生日期列；而北京的姓名改为了名字；上海专业改为科目，缺少了身高和体重栏）。然后在汇总表的A列上加入地区名（即北京、上海、广州的文件名）。

这应该怎么样编程？

liulang0808

楼主的示例标题貌似都有各种出入的，这种对应关系怎么去实现？

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    a = 2
    Set sh = ActiveSheet
    sh.UsedRange.Offset(1).ClearContents
    brr = Array("姓名", "专业", "年龄")
     Dim crr(2 To 4) As Integer
    Set fso = CreateObject("scripting.filesystemobject")
    For Each f In fso.getfolder(ThisWorkbook.Path).Files
        If f.Name <> ThisWorkbook.Name Then
            With Workbooks.Open(f)
                For j = 0 To 2
                    crr(j + 2) = .Sheets(1).Rows(1).Find(brr(j), lookat:=xlWhole).Column
                Next j
                arr = .Sheets(1).UsedRange
                For j = 2 To UBound(arr)
                    If Len(arr(j, 2)) > 0 Then
                        For i = 2 To 4
                            sh.Cells(a, i) = arr(j, crr(i))
                        Next i
                        sh.Cells(a, 1) = Split(f.Name, ".xl")(0)
                        a = a + 1
                    End If
                Next j
                .Close False
            End With
        End If
    Next f
    Application.DisplayAlerts = tr
    Application.ScreenUpdating = True
End Sub

liulang0808

如果楼主的各个工作部里的标题是专业，姓名，年龄这样标准的，可以自动统计出来，见现在附件 。
如果不是，需要楼主再代码自己设置具体是那几列然后提取

xiaohuaxiong

liulang0808 发表于 2015-12-16 09:23
Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

学习下3楼的代码，注释下：

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    a = 2
    Set sh = ActiveSheet
    sh.UsedRange.Offset(1).ClearContents '清楚汇总表除表头外的所有数据
    brr = Array("姓名", "专业", "年龄") '定义汇总表的表头数组
     Dim crr(2 To 4) As Integer
    Set FSO = CreateObject("scripting.filesystemobject") '调用FSO
    For Each f In FSO.getfolder(ThisWorkbook.path).Files '循环该路径下的各个分表
        If f.Name <> ThisWorkbook.Name Then
            With Workbooks.Open(f)
                For j = 0 To 2
                    crr(j + 2) = .Sheets(1).Rows(1).Find(brr(j), lookat:=xlWhole).Column
                    '把汇总表表头的各个列名在分表里的列号位置循环赋给数组crr
                    'xlWhole是查找完全匹配，xlPart是查找模糊匹配
                Next j
                arr = .Sheets(1).UsedRange '分表的使用区域赋给数组arr
                For j = 2 To UBound(arr) '循环数组arr
                    If Len(arr(j, 2)) > 0 Then '如果分表使用区域的第二列不为空的话
                        For i = 2 To 4
                            sh.Cells(a, i) = arr(j, crr(i)) '就把分表的各个对应的列赋值到汇总表的第a行，第i列
                        Next i
                        sh.Cells(a, 1) = Split(f.Name, ".xl")(0) '并且把分表文件名赋到汇总表的第一列
                        a = a + 1 '累加计数
                    End If
                Next j
                .Close False '关闭打开的分表，不保存修改
            End With
        End If
    Next f
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

lrh788

学习了！！！！！