题目一

题目要求：
要求大家编写程序自动在F列中标记出每一个交易记录是该客户的第几次交易。比如第3行的“赵六”是第一次出现，所以F3为 1 ，而第4行的“赵六”是第二次出现，所以F4应为 2 。

方法一：
双重循环

Option Explicit
Sub demo()Dim i As Long, j As Long, s As LongDim r As ObjectSet r = Application.ActiveSheet.UsedRangeFor i = 3 To r.Rows.count + r.Row - 1   If Cells(i, 6) = "" Then           s = 1Cells(i, 6) = s'标记第一次出现For j = i + 1 To r.Rows.count + r.Row - 1                If Cells(j, 3) = Cells(i, 3) Then'如果出现重复，就标记+1'先扫描完所有符合当前字段的，一一标记s = s + 1Cells(j, 6) = sEnd IfNext j        End If        Next i
End Sub

方法二：
字典

Sub 字典demo2()Dim dic As Object, r As Range, k, iSet dic = CreateObject("scripting.dictionary")'创建字典对象For i = 3 To 23k = Cells(i, 3).Valuedic(k) = dic(k) + 1'如果字典中已经有了姓名k，则取出数值并加1，再写会该条目'如果尚无k，则添加此姓名，并设置数值为空白+1Cells(i, 8) = dic(k)Next i
End Sub

题目二

题目要求：
按照GDP大小进行降序排列

使用冒泡排序
先给出C语言描述的冒泡排序作为参考

#include <stdio.h>#define ARR_LEN 255 /*数组长度上限*/
#define elemType int /*元素类型*//* 冒泡排序 */
/* 1. 从当前元素起，向后依次比较每一对相邻元素，若逆序则交换 */
/* 2. 对所有元素均重复以上步骤，直至最后一个元素 */
/* elemType arr[]: 排序目标数组; int len: 元素个数 */
void bubbleSort (elemType arr[], int len)
{elemType temp;int i, j;for (i=0; i<len-1; i++) /* 外循环为排序趟数，len个数进行len-1趟 */for (j=0; j<len-1-i; j++) { /* 内循环为每趟比较的次数，第i趟比较len-i次 */if (arr[j] > arr[j+1]) { /* 相邻元素比较，若逆序则交换（升序为左大于右，降序反之） */temp = arr[j];arr[j] = arr[j+1];arr[j+1] = temp;}}
}int main (void)
{elemType arr[ARR_LEN] = {3,5,1,-7,4,9,-6,8,10,4};int len = 10;int i;bubbleSort (arr, len);for (i=0; i<len; i++)printf ("%d\t", arr[i]);putchar ('\n');return 0;
}

再给出VBA代码

Sub 简单冒泡排序()Dim i, j As LongFor i = 3 To 23'第一个参与排序的数据位于第三行，数据总共20个For j = 3 To 26 - i'第一个参与数据的位置时第三列'一直需要遍历到数据长度20加上起始位置3加上i的起始位置3'再减去iIf cells(j, 3) < cells(j + 1, 3) Thencells(1, 2) = cells(j, 2)cells(j, 2) = cells(j + 1, 2)cells(j + 1, 2) = cells(1, 2)cells(1, 1) = cells(j, 3)cells(j, 3) = cells(j + 1, 3)cells(j + 1, 3) = cells(1, 1)'简单交换End IfNext jNext icells(1, 2) = ""cells(1, 1) = ""'清除中间变量
End Sub

但是要说一句，这种排序速度较慢，真正用还是用自带的函数比较好

题目三

使用Range.Sort方法，对2016年里约奥运会奖牌榜进行排序。排序规则为：主关键字是金牌数；如果金牌数相同则使用奖牌总数；如果奖牌总数也相同，则按国家名称的拼音顺序升序排列。

Sub 用sort()Dim r As RangeSet r = ActiveSheet.UsedRanger.Sort key1:=Range("c3"), order1:=xlDescending, key2:=Range("d3"), order2:=xlDescending, SortMethod:=xlPinYin'sort后面不加括号'传参给冒号和等号
End Sub

Range.Sort(key1,order1,key2,order2,key3,order3,Header,MatchCase,Orientation,Sortmethod)

分别是主关键字，顺序方式，次关键字，顺序方式，第三关键字，顺序方式，Header是排序是否包括第一行抬头，Matchcase在于是否匹配大小写，Orientation可以用来行排序，SOrtmethod可以用来按拼音排序

还有，如果数字设置为了文本格式，那么排序按照字符串还是数字，可以进行设置
dataoptional:=xlnormal文本 44排在305后面
dataoptional:=xlsorttextasnumbers看成数字，44排在305前面

题目四

使用Range.Sort的自定义排序功能，按照左侧的百家姓规则，对所有十张表格的第二列“姓名”进行排序。
赵钱孙李周吴郑王冯陈褚卫蒋沈韩杨

Option Explicit
Sub myOrder()Dim w As Worksheet, i As LongDim mylist()'将sheet3中的姓氏规则加入到Excel自定义序列中'注意如果Excel中已有相同的规则，那么本行语句会执行出错，需要先删除该规则。mylist = Array("赵", "钱", "孙", "李", "周", "吴", "郑", "王", "冯", "陈", "褚", "卫", "蒋", "沈", "韩", "杨")Application.AddCustomList mylist    For Each w In Worksheets   If w.Name <> "Sheet3" Then       '因为自定义排序必须“整单元格匹配”，所以先从工作表w中B列姓名里面取出“姓”（单字），并存入第一列以供排序使用。'如果实际工作中第一列或第三列已有数据、不能更改，可以用宏代码先插入一列，排序结束后再删除该列即可。i = 2Do While w.Cells(i, 2) <> ""w.Cells(i, 1) = Left(w.Cells(i, 2), 1)i = i + 1Loop'以第一列“姓”为关键字进行排序，排序后将该列清空以恢复表格原状。w.Range("a:b").Sort key1:=w.Range("a1"), ordercustom:=Application.CustomListCount + 1w.Range("a:a").Clear    End If    Next wApplication.DeleteCustomList Application.CustomListCount
End Sub

题目五

统计出席人数
在10个worksheet中，统计出席人数汇总

Sub 字典加数组()Dim tt = Timer()Dim dic As Object, r As Range, k, iDim w As Worksheet, wsum As WorksheetDim a()Set dic = CreateObject("scripting.dictionary")'创建字典对象Set wsum = Worksheets("出席统计") For Each w In WorksheetsIf w.Name <> "出席统计" Thena = w.UsedRangeFor Each k In adic(k) = dic(k) + 1'如果字典中已经有了姓名k，则取出数值并加1，再写会该条目'如果尚无k，则添加此姓名，并设置数值为空白+1Next kEnd IfNext wa = dic.Keys()wsum.Range("a2:a" & UBound(a) + 2) = Application.Transpose(a)a = dic.items()wsum.Range("b2:b" & UBound(a) + 2) = Application.Transpose(a)'利用数组赋值Worksheets("出席统计").UsedRange.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlYesMsgBox "一共用时" & Timer() - t & "秒"
End Sub

题目六

计算应交税

Sub 计算合并单元格()
Dim i As Long, r As RangeFor i = 3 To 14Set r = Cells(i, 5).MergeArea'取合并单元格Cells(i, 6) = Cells(i, 4) * r.Cells(1, 1).Value'取r中的第一个，.value保证取的值Next i
End Sub

题目七

拆分合并单元格或者合并单元格

Sub 拆分单元格()Dim i As Long, k As LongFor i = 3 To 14If Cells(i, 2).MergeCells = True Thenk = Cells(i, 2).MergeArea.Rows.Count'记录合并单元格的行数Cells(i, 2).UnMerge'拆分Range(Cells(i, 2), Cells(i + k - 1, 2)).Value = Cells(i, 2).Value'拆分后空的部分都补齐i = i + k - 1'拆分下来的部分就不要二次扫描了End IfNext i
End Sub

再合并回来

Sub 合并单元格()Dim i As Long, r As RangeApplication.DisplayAlerts = False'防止弹出警告对话框For i = 14 To 4 Step -1If Cells(i, 2) = Cells(i - 1, 2) ThenRange(Cells(i, 2), Cells(i - 1, 2)).MergeEnd IfNext iApplication.DisplayAlerts = True'恢复弹出框
End Sub

一般情况下，如果是用于计算，尽量避免合并单元格，单独用于展示的数据另说

题目八

按照每个公司的合计计件量（比如甲公司的D5单元格数字），由大到小对四个公司进行排序。

Sub orderDemo()Dim i&, j&, iRows&, jRows&        '以下使用选择排序法思想对表格进行排序i = 2Do While i <= 13    '让 j 从i的下一个公司（即下一个合并区域的首行）开始循环j = i + Cells(i, 1).MergeArea.Rows.CountDo While j <= 13             '获得当前i、j两个公司的合并区域总行数iRows = Cells(i, 1).MergeArea.Rows.CountjRows = Cells(j, 1).MergeArea.Rows.Count           '如果j公司最后一行第3列(即合计)大于i公司，则将j剪切到i前面If Cells(j + jRows - 2, 3) > Cells(i + iRows - 2, 3) ThenCells(j, 1).Resize(jRows, 4).CutCells(i, 1).Insert Shift:=xlDownEnd If            '让j的增加值为当前合并区域的总行数，从而直接跳到下一个公司上j = j + jRowsLoop        '让i的增加值为当前合并区域的总行数，从而直接跳到下一个公司上i = i + Cells(i, 1).MergeArea.Rows.CountLoop
End Sub

这个程序比较难，不是我自己写的，是来自杨老师的课程参考答案。

再次强调，数据表尽量避免合并单元格！！！！！

全民一起VBA实战篇第三课：文本内容的实用技巧相关推荐

全民一起VBA提高篇第十课：字典对象
字典题目要求将课程名称以及挂科人数进行汇总给出的数据是几十个班混在一起,挂科人数是每个班的人数,现在需要把他们相同的科目统计一个总人数只看这个要求,其实用数据透视表可以很快得出结果,但是任何E ...
全民一起VBA实战篇第一课：表格格式操作与Excel功能调用
文件打印 Sub 批量打印()Dim fn As String, wb As Workbook, ws As Worksheetfn = Dir("E:\EXCEL\*.xlsx" ...
全民一起VBA实战篇专题3 第一回格式化规定各人迥异，Format函数一招摆平
相关知识点: Format(原始内容,期望格式,每周起始日,每年起始周)将原始内容(数字.日期.文本等)转换成指定格式的字符串并返回.除了第一个参数(原始内容)外,其他参数均为可选. ...
全民一起VBA实战篇专题2 第二回选择法轻松上手，双循环巧妙排序
相关知识点: 选择排序法:在剩余数字中找出一个最大的数字,填入第一个空白方格里,如此反复,直到没有剩余数字.缺点是运行效率太低其他方法:堆排序,基数排序,快速排序,希尔排序,桶排序,归并排序,二叉树 ...
全民一起VBA实战篇专题4 第五回递归算法流程独特大事化小思路清奇
相关知识点: 区别于循环在于,把大问题转换成小问题,总结递进的推导公式:知道最小问题的答案(递归的停止条件). 例1 阶乘(循环语句) Sub demo() Msgbox 阶乘(4) End Sub ...
学习日志全民一起VBA提高篇第四回日期类型穿梭岁月时间函数算尽光阴
学习日志全民一起VBA提高篇第四回日期类型穿梭岁月时间函数算尽光阴相关知识点一.获取当前系统时间1. date() 或date 可获得日期如 2019/2/12. time() 或tim ...
基于 abp vNext 和 .NET Core 开发博客项目 - 博客接口实战篇（三）
基于 abp vNext 和 .NET Core 开发博客项目 - 博客接口实战篇(三) 转载于:https://github.com/Meowv/Blog 上篇文章完成了分类和标签页面相关的共6个接 ...
Linux shell 脚本编程-实战篇（三）
继: Linux shell 脚本编程-实战篇(二) 3. 一些小有意思的脚本 3.1 发送消息 3.1.1 功能分析对于这种简单的脚本,需要的功能不多.涉及的一些命令很常见,下面了解脚本所需的几个 ...
前缀学习完结篇第三课上
第三课(上)前缀完结由于突然决定考雅思,一边学习一边总结 supersized empower 授权 entitle authorize 双写最后一个字母加er 是表重复 batter 打击重复性 ...
Tekton CD 之实战篇（三）：从Github到k8s集群
Tekton CD 之实战篇(二):从Github到k8s集群 (如果对于云原生技术感兴趣,欢迎关注微信公众号"云原生手记") CICD逻辑图 CD概述我这边讲的CD是将用户的应 ...

全民一起VBA实战篇第三课：文本内容的实用技巧

题目一

题目二

题目三

题目四

题目五

题目六

题目七

题目八

全民一起VBA实战篇第三课：文本内容的实用技巧相关推荐

最新文章

热门文章