ts文件顺序太乱怎么合并_【Power Query & VBA】合并多个Excel

将多个相同字段类型的Excel文件，全部都放在一个文件夹。
然后全部统一合并到一个指定的Excel里。
{Power Query}
不仅可以将文件夹下所有的文件统一合并，并把所有的工作簿内的不同Sheet一并合并。
[关键知识点]：
1. M函数，Excel.Workbook(Content,true)
2. 判断文件内容是否与已有字段重复，如重复，则删除列
操作步骤与演示视频：

https://www.zhihu.com/video/1155080674686877696

{VBA}
其中我们可以Do While 循环，或者For Each也行。
用Dir函数，判断文件是否存在，以及相应的格式是否符合需求。
我们可以新建一个Excel工作簿，命名为“合并”

Sub 操作指定文件里的所有文件()
Dim mypath as string 
mypath = "D:Desktop百度经验test" '工作簿所在文件夹路径
MyFile = Dir(mypath & "*.xlsx") '获取文件夹里面文件,如果你的excel 文件后缀名不是.xlsx就要修改此处
Do While MyFile <> ""
   Call OpenFile(MyFile)
   MyFile = Dir '找寻下一个文件
Loop
'循环修改工作簿内容
End Sub


Function OpenFile(fileName)
 
 Set currentWorkBook = Workbooks.Open(mypath & "" & fileName)
 Call 合并工作表(currentWorkBook.Worksheets(1), currentWorkBook.Name)
currentWorkBook.Close True '/false,这句是关闭文件，close有两个参数，true是关闭保存修改，false是关闭时不保存修改

End Function

Sub 合并工作表(zuWorkBook As Worksheet, sheetName As String)
 
 WorkBookName = "合并.xlsx" '将工作表合并到此工作簿
 sheetCount = Workbooks(WorkBookName).Sheets.Count
 zuWorkBook.Copy After:=Workbooks(WorkBookName).Sheets(sheetCount)
 Set mSheet = Workbooks(WorkBookName).Sheets(sheetCount + 1
 mSheet.Name = sheetName '命名合并过来的工作表名为原本工作簿名称
 
End Sub
 

方法二，利用Getopenfilename，打开文件路径，并选择所需要合并的工作簿进行合并。
但这里并没有检测每张表的标题字段是否都一致，只是纯粹地在最后一行里继续添加新的内容。

Option Explicit
Sub mergeonexls() '合并多工作簿中指定工作表
On Error Resume Next
Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet
Dim t As Workbook, ts As Worksheet, l As Integer, h As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _
       Title:="Excel选择", MultiSelect:=True)
Set t = ThisWorkbook
Set ts = t.Sheets(1) '指定合并到的工作表，这里是第一张工作表
l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For Each x1 In x
   If x1 <> False Then
     Set w = Workbooks.Open(x1)
     Set wsh = w.Sheets(1) '指定所需合并工作表，这里是第一张工作表
     h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row
       If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then
         wsh.UsedRange.Copy ts.Cells(1, 1)
       Else
         wsh.UsedRange.Copy ts.Cells(h + 1, 1)
       End If
     w.Close
   End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub