第十七讲：商业实战演练1.案例一：批量打开文件夹中所有工作簿（Dir函数知识点）有时候我们经常需要打开一个文件夹下的所有工作簿，每次都要花上好几分钟时间，现在通过VBA就能实现几秒钟打开一个文件夹中的所有指定类型的文件，这里以打开一个文件夹下的所有Excel文件为例，如图所示是我们的文件夹结构，我们想要完成打开全部Excel类型文件而过滤其他类型文件的目标，首先是变量定义和代码执行前的准备工作，Sub 打开excel表格()
Dim myPath, myFile As String
Dim AK As Workbook
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动设定需要批量打开的文件夹路径，并获取指定文件类型的文件名，这里获取.xlsx类型的文件，
myPath = "C:\Users\Hao Wang\Desktop\Excel 整理\ExcelVBA整理\华小智业务一体化系统\第十七章 商业实战\2.批量打开文件\" '把文件路径定义给变量
myFile = Dir(myPath & "*.xlsx") '依次找寻指定路径中的*.xlsx文件通过循环，批量打开Excel文件，直到遍历该文件夹下的所有文件，
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
Application.Visible = True
End If
myFile = Dir '找寻下一个*.xlsx文件
Loop
Application.ScreenUpdating = True '解除屏幕禁止更新,此类语句一般成对使用
End Sub运行代码，可以看到，所有Excel文件都被成功打开，如此能够提高日常工作中批量处理文件的效率。2.案例二：一键合并多个Excel工作簿代码（Dir函数知识点）下面我们介绍如何实现将多个Excel中的数据合并到一个Excel文件中，首先我们观察我们需要合并的原始数据，这里我们有若干个具有相同表头的数据内容，我们的目标就是把这些数据都汇总到一个汇总excel文件中，代码如下，Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xlsx")
AWbName = ActiveWorkbook.Name首先进行变量定义和汇总文件名的获取，因为在遍历文件夹的过程中要区分汇总文件夹和源数据文件夹，对于源数据文件夹我们需要读取其中每个sheet表中的内容，如果获取的文件名是汇总文件名，则不需要读取
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) '返回除后缀之后的文件名
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) 'B列数据区域最后一行的行号
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop其中，Left(MyName, Len(MyName) - 4)表示从文件名的左侧返回去除文件后缀的文件名。Range("B65536").End(xlUp).Row 表示获取B列数据区域最后一行的行号，用于复制所有的数据区域，
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub3.案例三：批量新增工作表（Dir函数知识点）前面学习了很多批量操作，下面介绍一个向一个文件夹下的所有工作簿中都新增一个指定名称的工作表，在前面一节的基础上增加部分代码即可，Sub 批量新增工作表()
Dim myPath, myFile As String
Dim AK As Workbook
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
myPath = "C:\Users\Hao Wang\Desktop\Excel 整理\ExcelVBA整理\华小智业务一体化系统\第十七章 商业实战\3.批量新增工作表\" '把文件路径定义给变量
myFile = Dir(myPath & "*.xlsx") '依次找寻指定路径中的*.xls文件
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件以上部分是批量打开文件夹中指定类型文件的代码，之后需要在打开的文件中，调用Add函数添加一个工作表，添加的位置是在最后一个工作表的后面，使用after指定插入的相对位置，使用worksheets的count属性获取sheet表的数量，表示添加在最后一个工作表的后面，
Set sht = AK.Worksheets.Add(after:=Worksheets(Worksheets.Count))对新增的工作表，修改工作表的名称，
sht.Name = "新增工作表"关闭工作表，并保存相应的修改，
AK.Close SaveChanges:=True
操作完成后，对下一个工作簿进行相同操作。
End If
myFile = Dir '找寻下一个*.xls文件
Loop
Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
End Sub操作完成后打开一个在此文件夹下的Excel文件，可以看到相应的新增工作表已经添加到相应位置。4.案例四：批量删减工作表（Dir函数知识点）我们利用上一小节的批量新增工作表，在相同的文件夹下再次插入一系列新增待删除工作表，之后利用我们的批量删除工作表代码将其删除，新增的工作表代码如下，首先仍然是变量的定义，Sub 批量新增工作表()
Dim myPath, myFile As String
Dim AK As Workbook
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动由于在我们日常删除工作表的时候，Excel都会弹出一个提示窗口进行删除前的确认，这会导致程序的中断，因此我们可以通过取消提示来使程序持续运行，
Excel.Application.DisplayAlerts = False '取消excel警告这里是打开文件的操作，
myPath = "C:\Users\Hao Wang\Desktop\Excel 整理\ExcelVBA整理\华小智业务一体化系统\第十七章 商业实战\3.批量新增工作表\" '把文件路径定义给变量
myFile = Dir(myPath & "*.xlsx") '依次找寻指定路径中的*.xls文件
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件获取最后一个sheet表的序号，将其删除，之后关闭文件并保存修改，
i = Sheets.Count
'删除最后一张表
Sheets(i).Delete
AK.Close SaveChanges:=True
End If继续循环，批量完成整个文件夹文件的修改，
myFile = Dir '找寻下一个*.xls文件
Loop
Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
End Sub程序运行结束后打开文件查看效果，之前添加的待删除工作表已被成功删除。5.案例五：批量复制工作表到另一工作簿（Dir函数知识点）有时我们会遇到将同一份数据分别录入到不同Excel文件中，例如对于公司不同部门的销售额进行分季度统计，在部门不多的情况下还可以勉强通过手动的复制粘贴完成，如果需要复制的sheet表过多，通过人工的方式效率很低，我们通过VBA实现批量复制sheet表到另一工作簿中，“批量复制工作表”中的sheet表结构如下图所示，这里我们的目标是将“批量复制工作表”中的sheet表复制到四个季度的工作簿中，首先我们获取需要复制的所有工作表名称，将他们保存到一个数组中，Sub MoveSheets()
'在下面Array中列出所有需要复制的工作表的名称
Dim sh As Worksheet, arr, m
ReDim arr(1 To Sheets.Count, 0)
For Each sh In Sheets
m = m + 1
arr(m, 0) = sh.Name
Next之后开始遍历整个文件夹，
Set this = ThisWorkbook
myPath = "C:\Users\Hao Wang\Desktop\Excel 整理\ExcelVBA整理\华小智业务一体化系统\第十七章 商业实战\5.批量复制工作表\" '把文件路径定义给变量
myFile = Dir(myPath & "*.xlsx") '依次找寻指定路径中的*.xls文件
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then打开复制的目标文件，
Set AK = Workbooks.Open(myPath & myFile)将需要复制的工作表逐个复制到目标文件中，
For i = 1 To UBound(arr)
this.Sheets(arr(i, 0)).Copy After:=AK.Sheets(1)
Next关闭并保存目标文件，继续打开下一个文件复制，
AK.Close SaveChanges:=True
End If
myFile = Dir '找寻下一个*.xls文件
Loop
End Sub程序执行结束后，打开目标文件查看结果，所有待复制的sheet表都被复制到目标文件中。6.案例六：按条件拆分一个工作表为多个工作表（字典知识点）在统计项目时，我们可能最初会将所有项目的信息都存放在一个工作表中，但是随着项目增多，所有项目都保存到一个工作表中不利于整理和统计，如下所示，如果我们想要实现将所有的项目按照部门分类，即每个部门的项目分别保存到对应名称的工作表中，手动筛选肯定费时费力，可以通过VBA编程实现自动的数据筛选，代码如下，Sub 拆分工作表()
Dim d, arr, x&, L&, sh As Worksheet, r&, brr, y&, z&
Set sh = Sheets("数据源")
sh.Select为了提高程序的灵活度，我们设置一个对话框选择我们要进行分类的列号，
L = Application.InputBox("选择你要拆分的列", "温馨提示", Type:=8).Column
Application.ScreenUpdating = False添加的选择窗口如下所示，获取所选列的行数，保存该列内容到一个数组中，用于获取共有多少个待分类内容，并实例化一个字典对象，用于存储不同的部门名称，
r = Cells(Rows.Count, L).End(xlUp).Row
arr = Range(Cells(2, L), Cells(r, L))
Set d = CreateObject("Scripting.dictionary")这里我们为了只保留不同的分类字段，采用将字段作为字典键的方式，因为值不需要，所以设置为空即可，
For x = 1 To UBound(arr)
d(arr(x, 1)) = ""
Next x再将获取的键保存到一个数组中，这个数组保存的内容即为没有重复的分类字段，
brr = d.keys通过循环创建对应名字的工作表，
For z = 0 To UBound(brr)
Sheets.Add(after:=Sheets(Sheets.Count)).Name = Format(brr(z), "yyyymmdd")
sh.Select筛选同字段的信息行，这里判断Excel的版本号，不同版本调用筛选功能的代码稍有不同，
If Application.Version = 14 Then
Range("A1").CurrentRegion.AutoFilter L, "=" & Split(brr(z), "#")(0)
Else
Range("A1").CurrentRegion.AutoFilter L, Split(brr(z), "#")(0)
End If复制筛选出的区域，并复制粘贴到新建的工作表中，
Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
With Sheets(Sheets.Count)
.Range("A1").PasteSpecial xlPasteAll
.Cells.EntireColumn.AutoFit
End With
Range("A1").CurrentRegion.AutoFilter
Next z
Application.ScreenUpdating = True
End Sub程序运行结束后，查看运行效果，工作簿中新增了多个对应字段的工作表，再查看工作表中的内容，例如上图信托一部的工作表中，所有的信息只关于信托一部的员工内容。7.案例七：批量合并多个工作簿中的同名工作表（Dir + 复制粘贴知识点）有时候我们需要将多个工作簿中的信息进行汇总，例如将一个部门的四个季度的业务进行汇总整理，如图这是一个季度的信息，在多个Excel工作簿中都有这些表头相同的表格内容，如果通过手动复制的方式汇总到一个汇总表中未免太过繁琐枯燥，因此针对这一类工作我们依然选择使用VBA实现，代码如下，首先是相关变量的定义，Sub 合并工作表()
Dim path As String, filename As String
Dim ws As Workbook, w As Workbook
Dim starrow As Long, n As Long, r As Long, titlerow As Integer
path = "C:\Users\Hao Wang\Desktop\Excel 整理\ExcelVBA整理\华小智业务一体化系统\第十七章 商业实战\7.批量合并多个工作簿中同名工作表"新建一个汇总表工作簿，并定义好初始行号和标题所在行号，
filename = Dir(path & "\*.xlsx")
Set ws = Workbooks.Add
'每次复制时开始的行数
starrow = 1: n = 0: titlerow = 1
Application.DisplayAlerts = False设置需要汇总的工作表名称，
shtName = "信托一部"
Do While filename <> ""
Set w = Workbooks.Open(path & "\" & filename)
n = n + 1
'以下复制分表数据，第一张含表头，其他表格只复制数据区
With w.Worksheets(shtName)获取行和列的范围，
r = Cells.SpecialCells(xlCellTypeLastCell).Row
l = Split(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Address, "$")(1)如果是第一个需要汇总的文件，则连带表头复制，否则直接复制数据区域，不包含表头，
If n = 1 Then
.Range("a1", l & r).Select
Else
.Range("a" & (titlerow + 1), l & r).Select
End If
End With
Selection.Copy
w.Close在新创建的汇总表中，在对应位置粘贴相应内容，内容是从B列开始粘贴，A列作为新的列，用于提示信息的来源文件，
With ws.Worksheets(1)
.Range("b" & starrow).Select
.Paste
.Range("a" & starrow, "a" & (starrow + r - titlerow)) = Mid(filename, 1, Len(filename) - 5)
End With复制完后，根据B列中最后数据所在行号，重定义下次复制数据开始行号，
starrow = Range("b" & Rows.Count).End(xlUp).Row + 1
filename = Dir
Loop最后清除复制后的多余内容，
With ws.Worksheets(1)
.Range("a1", "a" & titlerow) = ""
.Range("a" & Rows.Count).End(xlUp).Value = ""
End With
Application.DisplayAlerts = True将文件保存并命名为“汇总表”。
ws.SaveAs path & "\汇总表.xlsx"
End Sub程序运行结束后，打开生成的汇总表，所有的内容都保存到其中。8.案例八：调整多个工作簿行高和列宽（RowHeight及ColumnWidth）有时我们可能会遇到调整工作簿行高，列宽的需求，如果通过手动设置的方式，未免过于繁琐枯燥，这里通过VBA程序可以实现将一个文件夹中的工作簿行高和列宽批量调整为我们想要的格式，文件格式如下所示。查看我们传统的改变行高和列宽的操作方式， 我们需要首先选中要修改的行或列，右键鼠标调出工具菜单，之后点击列宽或行高，再在弹出的对话框中修改对应的值，而通过VBA来实现自动修改的代码如下，首先是变量的定义和需要进行操作的文件名的获取，Sub 批量调整行高()
Dim MyPath, MyName
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path & ""
MyName = Dir(MyPath & "\" & "*.xlsx")通过循环，批量打开需要操作的文件，
Do While MyName <> "" And MyName <> ThisWorkbook.Name
Workbooks.Open MyPath & "\" & MyName设置单元格的属性，分别改变列宽和行高，
With ActiveSheet.Cells
’列宽
.ColumnWidth = 20
’行高
.RowHeight = 15
End With之后关闭并保存相应的文件，直到所有文件都操作完毕，退出程序即可。
ActiveWorkbook.Close Savechanges:=True
MyName = Dir
Loop
Application.ScreenUpdating = True
End Sub执行效果如下，通过查看列宽和行高，可以看到单元格的属性已被正确修改并保存。9.案例九：调整多个工作簿数据格式（NumberFormatLocal）如果我们遇到修改工作簿的数据格式，而且工作簿的数量不止一个，就又需要借助VBA程序实现批量的修改操作了，我们要进行操作的文件如下，假设我们有三个月的工作簿需要进行数据格式的修改，这是文件的原始内容，而我们想把日期的格式修改成“月/日”，把完成度的格式修改成百分比，并保留两位小数，下面我们通过VBA编程实现，首先是变量定义和文件名的获取，Sub 调整多个工作簿数据格式()
Dim MyPath, MyName
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path & ""
MyName = Dir(MyPath & "\" & "*.xlsx")之后通过循环实现文件的批量打开，
Do While MyName <> "" And MyName <> ThisWorkbook.Name
Workbooks.Open MyPath & "\" & MyName将A列的相关数据修改为“月/日”格式，并将C列数据改为百分比格式，
With ActiveSheet
.Range("A1:A65536").NumberFormatLocal = "m/d" '设置A列单元格为日期格式
.Range("C1:C65536").NumberFormatLocal = "0.00%"
'设置C列单元格为百分比格式
End With操作完成后保存退出。
ActiveWorkbook.Close Savechanges:=True
MyName = Dir
Loop
Application.ScreenUpdating = True
End Sub下面是程序执行结束后的效果，可以看到固定位置的数据都已经保存为固定的数据格式。10.案例十：批量替换多个工作簿行数据（IF+数组知识点）在Excel中已有替换功能，能够替换单个单元格中的数据，到时如果遇到想要替换某一行的数据该怎么做呢，如果逐一替换，在文件数量很多的情况下工作量太大，可以借助VBA中的IF语句实现，我们的目标是将每一行中名称为“背包”、单价为16并且数量为65的行（即["背包"、“16”、“65”]）改为["双肩包"、“36”、“79”]，下面是代码，首先变量定义和文件名的获取，Sub 批量替换多个工作簿行数据()
Dim i, j, arr
Dim MyPath, MyName
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path & ""
MyName = Dir(MyPath & "\" & "*.xlsx")通过循环打开相应文件，
Do While MyName <> "" And MyName <> ThisWorkbook.Name
Workbooks.Open MyPath & "\" & MyName
Set sh = ActiveSheet将数据区域整个保存到数组中，
arr = sh.Range("A1:C" & sh.Cells(Rows.Count, 3).End(xlUp).Row) 逐行判断是否是我们要进行替换的三元组内容，即是否为["背包"、“16”、“65”]，如果是，则将这一行的内容修改为对应的替换内容，
For i = 1 To UBound(arr)
If arr(i, 1) = "背包" And arr(i, 2) = 16 And arr(i, 3) = 65 Then
sh.Range("A" & i).Value = "双肩包"
sh.Range("B" & i).Value = 36
sh.Range("C" & i).Value = 79
End If
Next对所有的数据检查并修改完毕，关闭文件退出并保存。
ActiveWorkbook.Close Savechanges:=True
MyName = Dir
Loop
Application.ScreenUpdating = True
End Sub程序运行结束后，打开对应的文件查看，可以看到凡是符合条件的行都被替换为相应的内容，其他的内容保持不变。11.案例十一：批量提取一个工作簿中的特定数据（筛选+复制+粘贴）如果在一个工作簿中含有多个工作表，而我们想要将分布在多个工作表中的某一类数据筛选到一个汇总工作表中，如果在每个工作表中手动筛选并复制粘贴，效率太低，下面介绍如何编程实现我们的目标，如下是我们的原始数据，我们想要从中找到部门是“信托一部”的相应行并汇总，下面是代码部分，首先是变量定义，我们需要设置我们筛选的字段，该字段所在的列号以及需要筛选的工作表数量，Sub 批量提取一个工作簿中的特定数据()
Dim arr, sh As Worksheet
selectName = "信托一部"
colIndex = 2
startLoc = 1
sheetsNum = ActiveWorkbook.Worksheets.Count之后循环打开每个工作表，
For i = 1 To sheetsNum
Set sh = ActiveWorkbook.Worksheets(i)选中所有数据区域，并筛选相应的字段，
sh.Select
If Application.Version = 14 Then '版本不同，调用筛选的方式不同
sh.Range("A1").CurrentRegion.AutoFilter colIndex, "=" & selectName '筛选部门名称
Else
sh.Range("A1").CurrentRegion.AutoFilter colIndex, selectName
End If筛选完毕后将区域复制，sh.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy '筛选完毕，复制筛选的区域
创建一个同名的汇总工作表，位置在所有工作表最后
If startLoc = 1 Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = selectName
End If在汇总工作表中，粘贴复制的内容，修改列宽并更改下一次的粘贴位置，
With Sheets(Sheets.Count)
.Range("A" & startLoc).PasteSpecial xlPasteAll
'选择性粘贴中的全部粘贴
.Cells.EntireColumn.AutoFit
'自动调节工作表列宽
startLoc = .UsedRange.Rows.Count + 1
End With关闭筛选状态，程序继续打开下一个工作表进行筛选和复制。
sh.Range("A1").CurrentRegion.AutoFilter
'回到自动筛选前的状态
Next i
Application.ScreenUpdating = True
End Sub程序运行后的效果如下，打开这个汇总工作表，可以看到所有信托一部的信息都已汇总，由于两个数据来源是复制粘贴，所以两次筛选的内容完全相同。12.案例十二：批量排序工作簿（Sort知识点）我们在日常生活中可能会将工作表按照某个字段进行排序工作，如果有多个工作表需要排序，我们可以借助VBA实现批量的排序工作，我们的原始数据如下所示，假设我们要对每个工作表的“项目总金额”列，也就是F列进行排序，代码如下，Sub 批量排序工作簿()
Dim i As Integer
Dim maxRow As Integer
Dim sht As Worksheet首先是变量定义，打开相应的工作表
'遍历所有工作表
For i = 1 To ActiveWorkbook.Worksheets.Count
Set sht = ActiveWorkbook.Worksheets(i)激活当前工作表，因为Sort只能排序当前工作表，
sht.Activate获取最大行数和最大列数已经相应的列名，
maxRow = sht.UsedRange.Rows.Count
maxCol = sht.UsedRange.Columns.Count
colName = Split(Cells(1, maxCol).Address, "$")(1)选取范围进行排序，这里是选取所有数据区域；key是排序的列，这里写“F1”，表示以F列为依据排序，最多可以写3个key；order表示升序降序，其中升序用xlAscending表示，降序用xlDescending；Header表示是否有标题，由于我们选择的区域有标题，所以这里写Yes，
sht.Range("a1:" & colName & maxRow).Sort key1:=sht.Range("F1"), order1:=xlAscending, Header:=xlYes
Next i
End Sub检查程序执行后的文件，可以看到按照“项目总金额”字段升序排列。13.案例十三：批量求和工作簿（For循环 + 数字相加）对于很多相似格式的工作表数据，如果要进行求和操作，除了手动使用公式对多个工作表进行求和之外，还可以通过VBA实现批量的自动求和，下图是样例文件的工作表，共有五个，每个工作表中的求和列都分布在C列中，下面编写代码实现相应的求和功能，设置需要求和的列，并且通过一个变量标志有标题行，Sub 批量求和工作簿()
sumCol = "C"
ifTitle = True遍历所有工作表，获取当前表最大行数
For i = 1 To ActiveWorkbook.Worksheets.Count
Set sht = ActiveWorkbook.Worksheets(i)
sht.Activate
maxRow = sht.UsedRange.Rows.Count设置求和的起始位置， 如果数据区域含有标题，则从第二行开始获取数据，没有标题则从第一行开始，
If ifTitle = True Then
startLoc = 2
Else
startLoc = 1
End If
通过循环将求和列的所有数据进行累加并保存，
For j = startLoc To maxRow
aCount = aCount + Range(sumCol & j).Value
Next将求和的数值保存到数据列下方的空白单元格中，
sht.Range(sumCol & maxRow + 1).Value = aCount
Next i
End Sub检查文件，可以看到在对应位置保存了相应的求和数据。14.案例十四：批量统计工作簿最大值和最小值（Max和Min函数）除了上述通过代码进行批量的求和之外，我们也可以对格式相似的源数据进行诸如求取最大值和最小值的操作，以减少人工操作的时间，提高工作效率。我们依然对拥有五个工作表的工作簿进行批量求最值的操作，每个工作表中的数据格式如下图所示，实现批量求最值的代码如下，首先规定我们需要求最值的数据位于哪一列，Sub 批量统计工作簿最大值和最小值()
targetCol = "C"通过循环遍历每一个工作表并激活，
For i = 1 To ActiveWorkbook.Worksheets.Count
Set sht = ActiveWorkbook.Worksheets(i)
sht.Activate获取当前表最大行数，用于填写求和结果，
maxRow = sht.UsedRange.Rows.Count区分数据表格是否存在标题行，以确定计算数据的开始区域，
If ifTitle = True Then
startLoc = 2
Else
startLoc = 1
End If获取所有的数值并保存到一个数组中，
arr = Range(targetCol & startLoc & ":" & targetCol & maxRow)我们可以调用Application对象的相应Max/Min函数，求取数组中的最大值和最小值。
sht.Range(targetCol & maxRow + 1).Value = "最大值"
sht.Range(targetCol & maxRow + 2).Value = Application.Max(arr)
sht.Range(targetCol & maxRow + 3).Value = "最小值"
sht.Range(targetCol & maxRow + 4).Value = Application.Min(arr)
Next i
End Sub打开文件检查执行结果，相应的最值都已经填写到相应的位置。15.课程相关资源笔者获取方式：微信号获取添加如下微信：huaxz001 。笔者网站：华小智首页王宇韬相关课程可通过：京东链接：[https://search.jd.com/Search?keyword=王宇韬]，搜索“王宇韬”，在淘宝、当当也可购买。加入学习交流群，可以添加如下微信：huaxz001（请注明缘由）。各类课程可在网易云、51CTO搜索王宇韬，进行查看。