关于工作簿汇总的问题（表头不相同）

yzqe

关于工作簿合成的问题，表头不相同，完全没有头绪。

如果表头是相同的，这种汇总我没问题了，但是现在表头是不完全相同的
附件是其中三个表

级别

名称

告警源

定位信息

网元类型

MO对象

首次发生时间(NT)

告警ID

频次

最近发生时间(NT)

清除时间(NT)

确认时间(ST)

清除用户

确认用户

清除状态

RRU名称

确认状态

BBU名称

eNodeB ID

用户自定义标识

附加信息

所属子网

级别

告警ID

名称

告警源

网元类型

MO对象

定位信息

频次

最近发生时间(NT)

首次发生时间(NT)

清除时间(NT)

BBU名称

确认时间(ST)

RRU名称

确认状态

清除用户

确认用户

清除状态

eNodeB ID

用户自定义标识

附加信息

所属子网

级别

告警ID

名称

告警源

MO对象

网元类型

定位信息

频次

首次发生时间(NT)

最近发生时间(NT)

清除时间(NT)

确认时间(ST)

清除用户

确认用户

清除状态

RRU名称

确认状态

BBU名称

eNodeB ID

用户自定义标识

附加信息

所属子网

山冈飞衣

表头字段名称都一样，只是顺序不一样吗？

yzqe

山冈飞衣 发表于 2016-4-18 17:50
表头字段名称都一样，只是顺序不一样吗？

字段是相同的，顺序不同，因为一次就十几个表  不可能每次都去调整顺序，所以很麻烦

zhaogang1960

请参考：
Sub ADO法()
    Dim Fso As Object, File As Object, cnn As Object, rs As Object, SQL$, s$, n&, f$(), i&
    Application.ScreenUpdating = False
    Cells.ClearContents
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("adodb.connection")
    For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
        If File.Name Like "*.xlsx" And Left$(File.Name, 2) <> "~$" Then
            n = n + 1
            If n = 1 Then
                cnn.Open "provider=microsoft.Ace.oledb.12.0;extended properties=excel 12.0;data source=" & File
                SQL = "select * from [Sheet1$a6:w]"
                Set rs = cnn.Execute(SQL)
                ReDim f(0 To rs.Fields.Count - 1)
                For i = 0 To rs.Fields.Count - 1
                    f(i) = rs.Fields(i).Name
                Next
                s = "[" & Join(f, "],[") & "]"
                Range("A1").Resize(, i) = f
                Range("A2").CopyFromRecordset rs
            Else
                SQL = "select " & s & " from [Excel 12.0;Database=" & File & ";].[Sheet1$a6:w]"
                Range("A" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
            End If
        End If
    Next
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    Set File = Nothing
    Set Fso = Nothing
    Application.ScreenUpdating = True
End Sub

zhaogang1960

请测试附件
告警.rar (141.61 KB, 下载次数: 120)

2016-4-18 19:50 上传

点击文件名下载附件

yzqe

大神做的很好，唯一的缺陷就是  每个表后面有一个空行，然后有个总计 多少 条  把这个也合并了

zhaogang1960

yzqe 发表于 2016-4-18 21:47
大神做的很好，唯一的缺陷就是  每个表后面有一个空行，然后有个总计 多少 条  把这个也合并了

Sub ADO法()
    Dim Fso As Object, File As Object, cnn As Object, rs As Object, SQL$, s$, n&, f$(), i&
    Application.ScreenUpdating = False
    Cells.ClearContents
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("adodb.connection")
    For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
        If File.Name Like "*.xlsx" And Left$(File.Name, 2) <> "~$" Then
            n = n + 1
            If n = 1 Then
                cnn.Open "provider=microsoft.Ace.oledb.12.0;extended properties=Excel 12.0;data source=" & File
                SQL = "select * from [Sheet1$a6:w] where 名称<>''"
                Set rs = cnn.Execute(SQL)
                ReDim f(0 To rs.Fields.Count - 1)
                For i = 0 To rs.Fields.Count - 1
                    f(i) = rs.Fields(i).Name
                Next
                s = "[" & Join(f, "],[") & "]"
                Range("A1").Resize(, i) = f
                Range("A2").CopyFromRecordset rs
            Else
                SQL = "select " & s & " from [Excel 12.0;Database=" & File & ";].[Sheet1$a6:w] where 名称<>''"
                Range("A" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
            End If
        End If
    Next
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    Set File = Nothing
    Set Fso = Nothing
    Application.ScreenUpdating = True
End Sub

zhaogang1960

请测试附件
告警.rar (141.78 KB, 下载次数: 204)

2016-4-18 22:18 上传

点击文件名下载附件

yzqe

zhaogang1960 发表于 2016-4-18 22:18
请测试附件

已经测试   谢谢大神了   明天总算不用复制粘贴了

LMY123

SQL合并标题行顺序不同的多薄单表

补充内容 (2019-1-1 10:28):
同夹_多薄_指定表_合并成一薄一表_字段名相同_顺序不同_ADO法,已入库。