结合日常工作需要，收录或改写相关过程及函数，现共享给大家，希望能对大家有所帮助！
目录
1.1 批量处理框架Application.GetOpenFilename
2.1 字符串数组比对 / 两组数据比对是否一致（不要求元素位置意一一对应）
1. 过程
1.1 批量处理框架Application.GetOpenFilename
注1：GetOpenFilename：返回完整的文件名路径
注2：对主表操作时，均使用Mywantgetsheet（固定sheet，不会变化）
PS：因ActiveSheet为当前活动的工作表，当主程序调用函数后，活动工作表变为所调用的工作表，此时若继续使用ActiveSheet，则不是在Mywantgetsheet工作表上操作！！！
' 遍历工作簿
Sub Traverse_Workbook()
Dim f(), s As Integer
f = Application.GetOpenFilename(fileFilter:="xlsx文件(*.xlsx),*.xlsx",_
Title:="选择Excel文件", MultiSelect:=True)
' GetOpenFilename在点击“确定”时会返回选中的文件名数组,点击“取消”时会返回一个Boolean型的False
'判断是否是Boolean型(FASLE)就可以判断确定还是取消,选中文件时返回string类型
If TypeName(f) = "Boolean" Then Exit Sub
' 打开工作簿
For s = 1 To UBound(f)
' 设定当前打开工作簿名称为xlsxBook
' 原代码
' Workbooks.Open f(s), UpdateLinks:=0 '不更新外部链接
' Set xlsxBook = GetObject(f(s))
Set xlsxBook = Workbooks.Open f(s), UpdateLinks:=0 '不更新外部链接
'循环遍历当前工作簿的各个工作表
For startSheetNum = 1 To xlsxBook.Sheets.Count
' 设定第startSheetNum个sheet为活动sheet
Set Mywantgetsheet = xlsxBook.Worksheets(startSheetNum)
Mywantgetsheet.Select
' 重点！！！
' 针对每个活动sheet实现的功能函数写于此处
' 下一个sheet
Next startSheetNum
' 保存及关闭工作簿
xlsxBook.Save
xlsxBook.Close
' 继续打开下一个工作簿
Next
' 完成操作，显示"finish"
MsgBox "finish"
End Sub2. 功能函数
2.1 字符串数组比对 / 两组数据比对是否一致（不要求元素位置意一一对应）
Function Compare_Combination(M() As Variant, M_Temp() As Variant, num As Integer)
' M() 基准组合，M_Temp() 待比对组合，num 为元素数量
'比对结果，默认为True
Dim result As Boolean
result = True
Dim T(), T_Temp() As Variant
'高版本EXCEL内置sort函数时可使用
' Sort函数需数组为列存储时方可正确排序（行数据无法正确排序），因此需转置再排序
'T = Excel.Application.WorksheetFunction.Sort(Application.WorksheetFunction.Transpose(M))
'T_Temp = Excel.Application.WorksheetFunction.Sort(Application.WorksheetFunction.Transpose(M_Temp))
'内置sort函数对列数据进行排序，因为需改写为(i,1)-i行1列
'Dim i As Integer
'For i = 1 To num
' If T(i,1) <> T_Temp(i,1) Then
' result = False
' Exit For
' End If
'Next
' 低版本EXCEL自主构建sort函数
T = Sort_Array(M)
T_Temp = Sort_Array(M_Temp)
Dim i As Integer
For i = 0 To num - 1
If T(i) <> T_Temp(i) Then
result = False
Exit For
End If
Next
Compare_Combination = result
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Sort_Array(arr() As Variant) As Variant
Dim i, j As Integer
Dim temp As Variant
For i = LBound(arr) To UBound(arr)
For j = i + 1 To UBound(arr)
If VBA.StrComp(arr(i), arr(j), vbTextCompare) > 0 Then
' 字符顺序由小到大排序
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
Sort_Array = arr()
End Function2.2 排序函数（针对字符串数组，进行元素间排序）
Function Sort_Array(arr() As Variant) As Variant
Dim i, j As Integer
Dim temp As Variant
For i = LBound(arr) To UBound(arr)
For j = i + 1 To UBound(arr)
If VBA.StrComp(arr(i), arr(j), vbTextCompare) > 0 Then
' 字符顺序由小到大排序
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
Sort_Array = arr()
End Function2.3 INDEX + MATCH（VBA代码）
Function Data_Search(width As Integer, height As Integer, _
key As String, key_column As Integer, attri As String, _
attri_row As Integer) As String
' index + match 函数变体
' width 表格宽度行，根据哪行决定表格宽度
'height 表格高度列，根据哪列决定表格高度
' key 键 ； key_column 键所在列
'attri 属性; attri_row 属性所在列（不可用value_row 估计变量名有问题）
Dim iRowL, iColumnL As Integer
'Set up the count as the number of filled rows in the first column
iRowL = Cells(Rows.Count, height).End(xlUp).row
iColumnL = Cells(width, Columns.Count).End(xlToLeft).Column
Dim temp_row, temp_column As Double
temp_row = Application.WorksheetFunction.Match(key, ActiveSheet.Columns(key_column), 0)
temp_row = Application.WorksheetFunction.Match(attri, ActiveSheet.Rows(attri_row), 0)
Data_Search = Application.WorksheetFunction.Index(Range(Cells(1, 1), Cells(iRowL, iColumnL)), temp_row, temp_row)
End Function3. 表格批量处理函数
3.1 多工作薄多表格合并（表头格式一致）
Sub 多工作簿多表合并()
'多个工作薄中多张表格为同一数据结构
'此过程函数为合并至ThisWorkbook.Sheets(1)（在该sheet上运行此函数）
Dim f(), s As Integer
f = Application.GetOpenFilename(fileFilter:="xls/xisx文件(*.xls*),*.xls*", _
Title:="选择Excel文件", MultiSelect:=True)
' GetOpenFilename在点击“确定”时会返回选中的文件名数组,点击“取消”时会返回一个Boolean型的False
'判断是否是Boolean型(FASLE)就可以判断确定还是取消,选中文件时返回string类型
If TypeName(f) = "Boolean" Then Exit Sub
'表头的列数和行数
Dim irow, icoloum As Integer
irow = InputBox("表头有几行")
icoloum = InputBox("表头有几列")
' 打开工作簿
For s = 1 To UBound(f)
' 设定当前打开工作簿名称为xlsxBook
Workbooks.Open Filename:=f(s), UpdateLinks:=0 '不更新外部链接
Set xlsxBook = GetObject(f(s))
'循环遍历当前工作簿的各个工作表
For startSheetNum = 1 To xlsxBook.Sheets.Count
' 设定第startSheetNum个sheet为活动sheet
Set Mywantgetsheet = xlsxBook.Worksheets(startSheetNum)
Mywantgetsheet.Select
'i是数据源表的最后一行，j是目标表(数据表)的最后一行
Dim i, j As Integer
i = Mywantgetsheet.Cells(Rows.Count, 1).End(xlUp).Row '数据源表的最后一行行号
j = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'j是目标表(数据表)的最后一行
Mywantgetsheet.Range("a" & irow + 1).Resize(i - irow, icoloum).Copy ThisWorkbook.Sheets(1).Range("a" & j + 1)
' 下一个sheet
Next startSheetNum
' 保存及关闭工作簿
xlsxBook.Save
xlsxBook.Close
' 继续打开下一个工作簿
Next
' 完成操作，显示"finish"
MsgBox "finish"
End Sub3.2 依据属性值，拆分单表数据
Sub 工作表拆分()
'功能：根据ThisWorkbook.Sheets(1)某一属性拆分表格数据
'通用性：可通过替换ThisWorkbook.Sheets(1)，从而确定所拆分表格
'保留表头、以及以属性的各个值命名各表格
'表头的列数、行数，及拆分字段所在列
Dim irow, icoloum, arrtr_column As Integer
irow = InputBox("表头有几行、属性所在行数")
icoloum = InputBox("表头有几列、有几个属性")
arrtr_column = InputBox("请输入你要按哪列分")
'表格总行数 total_row
Dim total_row As Integer
total_row = ThisWorkbook.Sheets(1).Cells(Rows.Count, arrtr_column).End(xlUp).Row
'删除无意义的表
Application.DisplayAlerts = False '不显示警告框
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> ThisWorkbook.Sheets(1).Name Then
ws.Delete
End If
Next
Application.DisplayAlerts = True '显示警告框
'根据属性的值，建立新表
Dim i, k As Integer
'表头的下一行开始
For i = irow + 1 To total_row
k = 0 ' 标志位，0代表无重复表
'有重名，退出For循环
For Each ws In Worksheets
If ws.Name = ThisWorkbook.Sheets(1).Cells(i, arrtr_column) Then
k = 1
Exit For
End If
Next
' 无重名，建立新表
If k = 0 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = _
ThisWorkbook.Sheets(1).Cells(i, arrtr_column)
End If
Next
'利用筛选，确定数据，然后拷贝
For i = 2 To Worksheets.Count
ThisWorkbook.Sheets(1).Range("a1").Resize(total_row, icoloum).AutoFilter _
Field:=arrtr_column, Criteria1:=Worksheets(i).Name
ThisWorkbook.Sheets(1).Range("a1").Resize(total_row, icoloum).Copy _
Worksheets(i).Range("a1")
Next
'取消筛选
ThisWorkbook.Sheets(1).Range("a1").Resize(total_row, icoloum).AutoFilter
ThisWorkbook.Sheets(1).Select
MsgBox "已处理完毕"
End Sub
3.3 工作表拆分为新工作簿
Sub Copy_WS()
'拆分工作表至新工作簿，并将工作簿命名为工作表名称
Dim ws As Worksheet
For Each ws In Sheets
ws.Copy ' 无参数时，默认复制粘贴到新工作簿
'ActiveWorkbook 即为上一步copy工作表所新建的工作簿
'Save as 另存为... ； Save 保存至默认路径
ActiveWorkbook.SaveAs Filename:="d:\data\" & ws.Name & ".xlsx"
ActiveWorkbook.Close
Next
End Sub