文科生自学VBA-排序和设定单元格格式风格

--学而时习之，不亦说乎？有朋自远方来，不亦乐乎？学习编程成就更好的自己--

微软公司Office软件在商业办公领域一直占据着主流和主导地位，其中Excel在数据处理和分析领域有着强大的影响力，大部分人在经历几年职场历练后可以熟练的使用Excel函数和透视表功能，基本可以轻松完成绝大多数工作和任务。但实际上Office的强大和独特之处还在于VBA，因为VBA能够胜任好多个性化二次开发，减少重复机械劳动从而实现办公自动化，开发效率高且开发周期短，尤其对于Excel重度使用者来说会了VBA简直就是如虎添翼啊！！！

使用Excel过程中经常用到排序功能，比如对某一数据集合按某个字段进行升序；在制作报表的时候也会设定单元格的相应格式。如何使用VBA实现这两项任务呢？接下来拿东京奥运会奖牌数据集作为案例给大家演示一下：

数据样本初始状态如下：

以C列字段金牌总数进行降序排列：

以G列字段奖牌总数进行升序排列：

以E列字段铜牌总数进行降序排列：

其实就需要三个步骤：设定区域-划定区域-按列排序

调整一下字段头单元格格式：

使用With方法可同时设定多个参数，大家能根据实际需求来进行个性化调整和设置，是不是很简单哇？

代码汇总如下：

Sub Sort_Medel_Rank() '以金牌数量降序排列
Application.ScreenUpdating = False
Sheets("Details").Select
Dim rng As Range '设定一个区域初始值
Set rng = ActiveSheet.Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)) '划定数据内容区域
    rng.Sort Key1:=ActiveSheet.Range(Range("C2"), Range("C2").End(xlDown)), Order1:=xlDescending '指定某个字段进行降序排列
Application.ScreenUpdating = True
End Sub

Sub Sort_Medel_Total() '以总奖牌数量升序排列
Application.ScreenUpdating = False
Sheets("Details").Select
Dim rng As Range '设定一个区域初始值
Set rng = ActiveSheet.Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)) '划定数据内容区域
    rng.Sort Key1:=ActiveSheet.Range(Range("G2"), Range("G2").End(xlDown)), Order1:=xlAscending  '指定某个字段进行升序排列
Application.ScreenUpdating = True
End Sub

Sub Sort_Medel_Bronze() '以铜牌数量降序排列
Application.ScreenUpdating = False
Sheets("Details").Select
Dim rng As Range '设定一个区域初始值
Set rng = ActiveSheet.Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)) '划定数据内容区域
    rng.Sort Key1:=ActiveSheet.Range(Range("E2"), Range("E2").End(xlDown)), Order1:=xlDescending  '指定某个字段进行降序排列
Application.ScreenUpdating = True
End Sub

Sub Set_Format()
Application.ScreenUpdating = False
Sheets("Details").Select
Rows(1).RowHeight = 20 '设定行高
With Range(Range("A1"), Range("A1").End(xlToRight))
    .Interior.ColorIndex = 19 '设定单元格背景颜色
    .Borders.Weight = xlMedium '设置边框粗细程度
    .Font.Name = "微软雅黑" '设定字体格式
    .HorizontalAlignment = xlCenter '设定单元格内字符居中显示
    .Font.FontStyle = "加粗" '设定字体加粗
    .Font.ColorIndex = 3     '设定字体颜色
End With
Application.ScreenUpdating = True
End Sub

END

我为人人，人人为我！！欢迎大家关注，点赞和转发！！！

~~人生不是赛场，梦想不容退场~~不断努力学习蜕变出一个更好的自己，不断分享学习路上的收获和感悟帮助他人成就自己！！！