文章目录
- 一、答题要求:
- 二、简答题:
- 1) 请使用至少三种方法,输出一个表有多少行数据,简要说明下你对各种方式的理解
- 2) 给定一个sheet对象,输出该sheet对象的最大行数、最大列数
- 3) 请使用一条代码,打开一个word文件(文件路径为"D:\Test.docx")
- 4) 已知一个二维数组arr,输出该数组一维、二维的最大下标
- 5) 以“月日年 时分秒”格式(如03182022 103045)输出当前时间
- 6) 假设当前日期变量vDate,请使用一条代码输出该变量上一个月份的最后一天日期(如vDate=”2022-03-10”,则输出2022-02-28)
- 7) 已知一个一维数组arr(1 to 8),请使用代码将数组内容填写在表sht的A1:A8单元格中
- 8) 在excel文件中,如何实现鼠标点击任意单元格,程序弹框Msgbox提示框,输出当前单元格的内容
- 9) 不运行程序,请说出以下程序执行test1后a,b,c的值各是多少,并说明输出结果的缘由
- 10)请用三种方式,判断字符串strA是否包含字符串strB
- 三、实践题:
- 1) 参考Macro.xlsm文件的” 试题1_数据排序”sheet,请将A列的数据进行升序排序,将排序后的结果填到B列
- 2) 给定文件夹“试题二测试文件夹“,将该文件夹中所有后缀为xlsx的文件名,输出到Macro.xlsm文件的” 试题2_变量文件夹”表中
- 3) 请编写程序,将Macro.xlsm文件的” 试题3_原数据”表序号为偶数的数据行全部删除,同时将剩余数据中年龄大于30的员工ID单元格背景颜色标记为红色(vbred)
- 4) 给定txt文件” 试题四测试文件.txt”,请将txt中数据读取写入到Macro.xlsm的“试题4_Txt解析“sheet,注意需要将txt中微信/支付宝交易号、交易金额对应的填到A列、B列
- 5) 请先在Macro.xslm文件的”试题5_邮件配置”设定好收件人、抄送人、邮件主题、邮件正文,再编写程序,以个人邮箱账号发送一封邮件,需要将” 试题五邮件附件”文件夹中测试邮件附件一.xlsx、测试邮件附件二.docx两个文件做为附件发送
- 6) 代码实现,将“试题六测试图片.png“图片插入到Macro,xlsm文件的” 试题6_图片处理”表A1单元格,并将图片填充满A1单元格(调好对应高度、宽度)
- 7) 请使用两种方法,判断一个工作簿(wb)是否存在指定名称(strSheetName)的sheet
- 8) 请编写程序,将Macro.xlsm文件” 试题8_工时诊疗人次”的总门诊人次、总出诊时长,按医生工号关联填到” 试题8_门诊日志明细”的总门诊人次、总出诊时长列;如果医生工号在” 试题8_门诊日志明细“中,则将该医生的最后出诊时间(就诊日期&就诊时间最大值)填到” 试题8_工时诊疗人次”的最后出诊时间列
- 9) 请将“试题九原数据.xlsx“文件的数据,按站点、实际承运公司汇总含税金额,填到” 测试题9_结果表&配置表”的” 十货站客机腹舱开票明细”中。
- 10)请将“试题十测试文件夹“中所有文件的数据汇总到” 测试题10_结果表”
- 四、数据源模板表下载
一、答题要求:
1.简答题,请直接将你的代码,写在每个题后面
2.实践题,请将代码写在Macro.xlsm文件上,并按一下方式存储代码
3.代码中sub、function、变量等,不允许使用中文
4.注意代码规范,包括变量命名、代码缩进、代码注释等,不按规范的统一打回调整
5.请勿移动试题打包的所有文件,如需获取” 试题四测试文件.txt”文件数据,代码中文件路径请以ThisWorkbook.Path & “\试题四测试文件.txt”类似方式拼接使用
二、简答题:
1) 请使用至少三种方法,输出一个表有多少行数据,简要说明下你对各种方式的理解
① ThisWorkbook.Sheets("工作表名").Range("A" & Sheets("工作表名").Rows.Count).End(xlUp).row
从指定位置内获取边界:获取A列行数据,在excel最大值区间范围内从下往上找到边界行数
② ThisWorkbook.Sheets(“工作表名”).UsedRange.Rows.cout
返回当前区域,即以空行和空列的组合为边界的区域
③ ThisWorkbook.Sheets(“工作表名”).Range(“A1”).CurrentRegion.Rows.cout
返回当前工作表中已使用的单元格围成的矩形区域,不管该区域中是否有空行,空列,或空单元格
2) 给定一个sheet对象,输出该sheet对象的最大行数、最大列数
① 最大行数:ThisWorkbook.Sheets("工作表名").Range("A" & Sheets("工作表名").Rows.Count).End(xlUp).row
② 最大列数:ThisWorkbook.Sheets("工作表名").Range("A1").End(xlToRight).Column
3) 请使用一条代码,打开一个word文件(文件路径为"D:\Test.docx")
Workbooks.open(“D:\Test.docx”)
4) 已知一个二维数组arr,输出该数组一维、二维的最大下标
Debug.print UBound(arr)
Debug.print UBound(arr(0))
5) 以“月日年 时分秒”格式(如03182022 103045)输出当前时间
Debug.Print Application.Text(Now(), "MMddyyyy hhmmss")
Debug.Print Format(Now(), "MMddyyyy hhmmss")
6) 假设当前日期变量vDate,请使用一条代码输出该变量上一个月份的最后一天日期(如vDate=”2022-03-10”,则输出2022-02-28)
vDate=”2022-03-10”,则输出2022-02-28)
Debug.Print CDate(vDate) - Day(vDate)
Debug.Print DateSerial(Year(vDate), Month(vDate), 0)
7) 已知一个一维数组arr(1 to 8),请使用代码将数组内容填写在表sht的A1:A8单元格中
① For i = 1 To UBound(arr)
Sht.Range("A" & i) = arr(i)
Next
② For i = 1 To UBound(arr)
arr(i) = i
Next
Range("a1:a" & UBound(arr)) = Application.Transpose(arr)
8) 在excel文件中,如何实现鼠标点击任意单元格,程序弹框Msgbox提示框,输出当前单元格的内容
① Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox Selection.Value
End Sub
9) 不运行程序,请说出以下程序执行test1后a,b,c的值各是多少,并说明输出结果的缘由
Sub test1()
Dim a%, b%, c%
a = 2: b = 4: c = 6
Call test2(a, b, c)
End Sub
Sub test2(a As Integer, ByVal b As Integer, ByRef c As Integer)
a = 20
b = 40
c = 60
End Sub
结果为:a = 20; b=4; c=60
10)请用三种方式,判断字符串strA是否包含字符串strB
①Debug.Print InStr(strA,strB) 大于0表示包含,否则包含
②Debug.Print strA Like "*strB*" True表示包含,False表示不包含
③Debug.Print strA.IndexOf(strB) 大于0表示包含,-1代表不包含
三、实践题:
1) 参考Macro.xlsm文件的” 试题1_数据排序”sheet,请将A列的数据进行升序排序,将排序后的结果填到B列
- 要求:
-
a) 不可以使用Excel上自带的排序功能
-
b) 给的样例数据A列数字个数只写了10个,代码实现时不能固定死,需要动态读取A列的数据个数
'试题1_数据排序-不带排序功能
Sub MainTest2()
Dim wb As Workbook, sht As Worksheet, rRows As Integer, beforeArr As Variant, I As Integer, j As Integer, Number As Integer
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题1_数据排序")
rRows = sht.Range("A1").CurrentRegion.Rows.Count
beforeArr = sht.Range("A1:A" & rRows)
ReDim afterArr(1 To UBound(beforeArr), 1 To 1)
For I = 1 To UBound(beforeArr)
Number = 0
For j = 1 To UBound(beforeArr)
If beforeArr(I, 1) - beforeArr(j, 1) > 0 Then
Number = Number + 1
End If
Next
afterArr(Number + 1, 1) = beforeArr(I, 1)
Next
sht.Range("B1:B" & rRows) = afterArr
End Sub
2) 给定文件夹“试题二测试文件夹“,将该文件夹中所有后缀为xlsx的文件名,输出到Macro.xlsm文件的” 试题2_变量文件夹”表中
- 要求:必须使用两种方法,一种方法不得分,方法一的结果输出到A列,方法二输出到B列
'试题2_变量文件夹-方法1-Dir对象
Sub MainTest2_1()
Dim fileName As String, folder As String, sht As Worksheet, i As Integer, wb As Workbook
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题2_变量文件夹")
folder = wb.Path & "\" & "试题二测试文件夹\"
fileName = Dir(folder & "*.xlsx")
i = 2
Do While fileName <> ""
sht.Range("A" & i) = folder & fileName
fileName = Dir
i = i + 1
Loop
End Sub
'试题2_变量文件夹-方法2-Scripting.FileSystemObject(只获取指定目录下的文件)
Sub MainTest2_2()
Dim fileName As Variant, folder As String, sht As Worksheet, i As Integer, wb As Workbook
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题2_变量文件夹")
folder = wb.Path & "\" & "试题二测试文件夹\"
i = 2
With CreateObject("Scripting.FileSystemObject").GetFolder(folder)
For Each fileName In .Files
Debug.Print fileName.Name
If fileName Like "*.xlsx" Then
sht.Range("B" & i) = fileName
i = i + 1
End If
Next
End With
End Sub
3) 请编写程序,将Macro.xlsm文件的” 试题3_原数据”表序号为偶数的数据行全部删除,同时将剩余数据中年龄大于30的员工ID单元格背景颜色标记为红色(vbred)
- 注:每次测试运行完,可从“试题3_原数据备份“表还原数据
'练习3
Sub MainTest3()
Dim wb As Workbook, sht As Worksheet, copySht As Worksheet, iRows As Integer, rng As Range, i As Integer
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题3_原数据")
Set copySht = wb.Sheets("试题3_原数据备份")
sht.Cells.Clear
copySht.Cells.Copy sht.Cells
iRows = sht.Range("A1").CurrentRegion.Rows.Count
For i = iRows To 2 Step -1
If CInt(sht.Range("A" & i)) Mod 2 = 0 Then
sht.Rows(i).Delete
ElseIf CInt(sht.Range("C" & i)) > 30 Then
sht.Range("C" & i).Interior.ColorIndex = 3
End If
Next
End Sub
4) 给定txt文件” 试题四测试文件.txt”,请将txt中数据读取写入到Macro.xlsm的“试题4_Txt解析“sheet,注意需要将txt中微信/支付宝交易号、交易金额对应的填到A列、B列
'练习4-方法1-Workbooks.OpenText
Sub MainTest4_1()
Application.ScreenUpdating = False
Dim wb As Workbook, sht As Worksheet, txtFileName As String, sht1 As Worksheet
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题4_Txt解析")
txtFileName = ThisWorkbook.Path & "\试题四测试文件.txt"
Workbooks.OpenText fileName:=txtFileName, Space:=True
Set sht1 = ActiveWorkbook.Sheets("试题四测试文件")
sht1.Range("A2:B" & sht1.Range("A1").CurrentRegion.Rows.Count).Copy sht.Range("A2")
ActiveWorkbook.Close (False)
Application.ScreenUpdating = True
End Sub
'练习4—方法2-CreateObject("Scripting.FileSystemObject").OpenTextFile()
Sub MainTest4_2()
Dim wb As Workbook, sht As Worksheet, txtFileName As String, fso As Object, txtContents As String, txtArr As Variant, i As Integer
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题4_Txt解析")
txtFileName = ThisWorkbook.Path & "\试题四测试文件.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
txtContents = fso.OpenTextFile(txtFileName).ReadAll
txtArr = Split(txtContents, Chr(10))
For i = 1 To UBound(txtArr)
sht.Range("A" & i + 1) = Split(txtArr(i), Chr(32))(0)
sht.Range("B" & i + 1) = Split(txtArr(i), Chr(32))(1)
Next
End Sub
5) 请先在Macro.xslm文件的”试题5_邮件配置”设定好收件人、抄送人、邮件主题、邮件正文,再编写程序,以个人邮箱账号发送一封邮件,需要将” 试题五邮件附件”文件夹中测试邮件附件一.xlsx、测试邮件附件二.docx两个文件做为附件发送
'练习题5-发送outlook邮件-需要引用Microsoft outlook * Object Library
Sub MainTest5()
Dim myOLApp As Object, objMail As Object, wb As Workbook, sht As Worksheet, folder As String, iRows As Integer, i As Integer
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题5_邮件配置")
folder = ThisWorkbook.Path & "\试题五邮件附件\"
Set myOLApp = CreateObject("Outlook.Application")
Set objMail = myOLApp.CreateItem(olMailItem)
iRows = sht.Range("A1").CurrentRegion.Rows.Count
With objMail
For i = 1 To iRows
If sht.Range("A" & i).Value = "收件人:" Then
.To = sht.Range("B" & i).Value
ElseIf sht.Range("A" & i).Value = "抄送人:" Then
.CC = sht.Range("B" & i).Value
ElseIf sht.Range("A" & i).Value = "主题:" Then
.Subject = sht.Range("B" & i).Value
ElseIf sht.Range("A" & i).Value = "正文:" Then
.Body = sht.Range("B" & i).Value
End If
Next
.Attachments.Add folder & "测试邮件附件一.xlsx"
.Attachments.Add folder & "测试邮件附件二.docx"
.Send
End With
End Sub
6) 代码实现,将“试题六测试图片.png“图片插入到Macro,xlsm文件的” 试题6_图片处理”表A1单元格,并将图片填充满A1单元格(调好对应高度、宽度)
'练习题6
Sub MainTest6()
Dim wb As Workbook, sht As Worksheet, fileName As String
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题6_图片处理")
fileName = ThisWorkbook.Path & "\试题六测试图片.png"
With sht.Pictures.Insert(fileName)
.ShapeRange.LockAspectRatio = msoFalse '取消图片纵横比锁定
.Placement = xlMoveAndSize '设置图片的大小和位置随单元格而变
.ShapeRange.Left = Range("A1").Left '设置所插入图片的左边界位置
.ShapeRange.Top = Range("A1").Top '设置所插入图片的上边界位置
.ShapeRange.Height = Range("A1").Height '设置所插入图片的高度与单元格的高度相等
.ShapeRange.Width = Range("A1").Width '设置所插入图片的宽度与单元格的宽度相等
End With
End Sub
7) 请使用两种方法,判断一个工作簿(wb)是否存在指定名称(strSheetName)的sheet
'练习题7-方法1
Sub MainTest7_1()
Dim wb As Workbook, sht As Worksheet, strSheetName As String, bl As Boolean
Set wb = Workbooks(ThisWorkbook.Name)
strSheetName = "halo"
bl = False
For Each sht In wb.Worksheets
If sht.Name = strSheetName Then
bl = True
Exit For
Else
bl = False
End If
Next
If bl Then
Debug.Print "存在!"
Else
Debug.Print "不存在!"
End If
End Sub
'练习题7-方法2-字典
Sub MainTest7_2()
Dim wb As Workbook, sht As Worksheet, dic As Object, strSheetName As String
Set wb = Workbooks(ThisWorkbook.Name)
strSheetName = "试题6_图片处理"
Set dic = CreateObject("Scripting.Dictionary")
For Each sht In wb.Worksheets
dic(sht.Name) = ""
Next
If dic.exists(strSheetName) Then
Debug.Print "存在!"
Else
Debug.Print "不存在!"
End If
End Sub
8) 请编写程序,将Macro.xlsm文件” 试题8_工时诊疗人次”的总门诊人次、总出诊时长,按医生工号关联填到” 试题8_门诊日志明细”的总门诊人次、总出诊时长列;如果医生工号在” 试题8_门诊日志明细“中,则将该医生的最后出诊时间(就诊日期&就诊时间最大值)填到” 试题8_工时诊疗人次”的最后出诊时间列
- 要求:
- a) 尽可能使用字典进行处理,不可以使用双层循环匹配的方式
- b) 所有需使用的字段,如” 试题8_工时诊疗人次”的医生工号在C列,代码中尽量不使用C列、第3列等方式读取数据,而采用标题名称”医生工号“来动态识别,避免表格随时列位置随时变动带来的代码修改
'练习题8
Sub MainTest8_1()
Dim wb As Workbook, dic As Object, i As Integer, filterRows As Integer, dynamicAddress As String, dynamicAddress1 As String
Dim sht As Worksheet '试题8_门诊日志明细sheet
Dim sht1 As Worksheet '试题8_工时诊疗人次sheet
Dim rng As Range, iRows As Integer, rngAddress As String
Dim rng1 As Range, iRows1 As Integer, rngAddress1 As String
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("试题8_门诊日志明细")
Set sht1 = wb.Sheets("试题8_工时诊疗人次")
Set dic = CreateObject("Scripting.Dictionary")
iRows = sht.Range("A1").CurrentRegion.Rows.Count
iRows1 = sht1.Range("A1").CurrentRegion.Rows.Count
Call timeSort(sht, iRows, getColumnCode("就诊日期", sht), getColumnCode("就诊时间", sht), getColumnCode("医生工号", sht)) '就诊日期-就诊时间升序排序
rngAddress = getColumnCode("医生工号", sht)
rngAddress1 = getColumnCode("医生工号", sht1)
i = 2
'填写总门诊人次和总出诊时长
For Each rng In sht.Range(rngAddress & "2:" & rngAddress & iRows)
sht1.Range(rngAddress1 & "1:" & rngAddress1 & iRows1).AutoFilter
sht1.Range(rngAddress1 & "1:" & rngAddress1 & iRows1).AutoFilter field:=1, Criteria1:=rng.Value
filterRows = sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If filterRows > 1 Then
dynamicAddress = getColumnCode("总门诊人次", sht)
dynamicAddress1 = getColumnCode("总门诊人次", sht1)
sht.Range(dynamicAddress & i) = sht1.Range(dynamicAddress1 & filterRows)
dynamicAddress = getColumnCode("总出诊时长", sht)
dynamicAddress1 = getColumnCode("总出诊时长", sht1)
sht.Range(dynamicAddress & i) = sht1.Range(dynamicAddress1 & filterRows)
Else
sht.Range("E" & i) = "医生工号未筛选到!总门诊人次为空"
sht.Range("F" & i) = "医生工号未筛选到!总出诊时长为空"
End If
sht1.Range(rngAddress1 & "1:" & rngAddress1 & iRows1).AutoFilter
i = i + 1
Next
i = 2
'填写最后出诊时间
For Each rng1 In sht1.Range(rngAddress1 & "2:" & rngAddress1 & iRows1)
sht.Range(rngAddress & "1:" & rngAddress & iRows).AutoFilter
sht.Range(rngAddress & "1:" & rngAddress & iRows).AutoFilter field:=1, Criteria1:=rng1.Value
filterRows = sht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If filterRows > 1 Then
dynamicAddress = getColumnCode("最后出诊时间", sht1)
sht1.Range(dynamicAddress & i) = sht.Range("B" & filterRows) & "&" & sht.Range("C" & filterRows)
Else
sht1.Range(dynamicAddress & i) = "医生工号未筛选到!最后出诊时间为空"
End If
sht.Range(rngAddress & "1:" & rngAddress & iRows).AutoFilter
i = i + 1
Next
End Sub
'动态根据关键字列得到列号
Function getColumnCode(keyName As String, sht As Worksheet)
getColumnCode = Split(sht.Cells.Find(keyName, lookat:=xlWhole).Address(1, 0), "$")(0)
End Function
'时间排序
Sub timeSort(sht As Worksheet, iRows As Integer, column1 As String, column2 As String, column3 As String)
sht.Sort.SortFields.Clear
sht.Sort.SortFields.Add2 Key:=Range(column1 & "2:" & column1 & iRows), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
sht.Sort.SortFields.Add2 Key:=Range(column2 & "2:" & column2 & iRows), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With sht.Sort
.SetRange Range(column1 & "1:" & column3 & iRows)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
9) 请将“试题九原数据.xlsx“文件的数据,按站点、实际承运公司汇总含税金额,填到” 测试题9_结果表&配置表”的” 十货站客机腹舱开票明细”中。
- 注:数据汇总时需要做两次转化
-
a) 需要将原数据A列的航站,与” 测试题9_结果表&配置表”E列三字代码匹配转化为F列站点,与结果表G列的对应
-
b) 需要将原数据D列实际承运分公司,与” 测试题9_结果表&配置表”A 列匹配转化为B列承运公司,与结果表第二行的对应
'练习题9-方法1
Sub MainTest9()
Dim wb As Workbook, sht As Worksheet, fileName As String, wb1 As Workbook, sht1 As Worksheet, iRows As Long, dynamicAddress As String, dynamicAddress1 As String, iRows1 As Long
Dim dict As Object, dict1 As Object, rng As Range, rng1 As Range, totalMoney As Double, rng2 As Range, i As Integer, dict3 As Object, j As Long
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Sheets("测试题9_结果表&配置表")
fileName = ThisWorkbook.Path & "\试题九原数据.xlsx"
Set wb1 = Workbooks.Open(fileName)
Set sht1 = wb1.Sheets(1)
Set dict = CreateObject("scripting.dictionary") '承运公司,实际承运分公司关键字键值
Set dict1 = CreateObject("scripting.dictionary") '三字代码,站点关键字键值
Set dict3 = CreateObject("scripting.dictionary") '实际承运分公司,承运公司关键字键值
dynamicAddress = getColumnCode("实际承运分公司", sht)
dynamicAddress1 = getColumnCode("承运公司", sht)
iRows = sht.Range(dynamicAddress & "1").CurrentRegion.Rows.Count
'承运公司关键字列
For Each rng In sht.Range(dynamicAddress & "2:" & dynamicAddress1 & iRows)
If rng(1, 2) <> "" Then
dict.Add rng(1, 2).Value, rng(1, 1).Value
End If
Next
'实际承运分公司关键字列
For Each rng In sht.Range(dynamicAddress & "2:" & dynamicAddress1 & iRows)
If rng(1, 2) <> "" Then
dict3.Add rng(1, 1).Value, rng(1, 2).Value
End If
Next
dynamicAddress = getColumnCode("三字代码", sht)
dynamicAddress1 = getColumnCode("站点", sht)
iRows = sht.Range(dynamicAddress & "1").CurrentRegion.Rows.Count
'站点关键字列
For Each rng In sht.Range(dynamicAddress & "2:" & dynamicAddress1 & iRows)
If rng(1, 2) <> "" Then
dict1.Add rng(1, 2).Value, rng(1, 1).Value
End If
Next
iRows = sht.Range("G3").CurrentRegion.Rows.Count - 1
iRows1 = sht1.Range("A65536").End(xlUp).Row
i = 3
For Each rng In sht.Range("G3:G" & iRows)
totalMoney = 0
If dict1.exists(rng.Value) Then
For Each rng1 In sht.Range("H2:M2")
If dict.exists(rng1.Value) Then
For j = 2 To iRows1
If dict.Item(rng1.Value) = "其他" Then
If dict3.exists(sht1.Range(getColumnCode("航站", sht1) & j).Value) And sht1.Range(getColumnCode("航站", sht1) & j).Value <> "其他" Then
ElseIf dict1.Item(rng.Value) = sht1.Range(getColumnCode("实际承运分公司", sht1) & j).Value Then
totalMoney = totalMoney + sht1.Range(getColumnCode("含税金额", sht1) & j).Value
End If
ElseIf dict.Item(rng1.Value) = sht1.Range(getColumnCode("航站", sht1) & j).Value And sht1.Range(getColumnCode("含税金额", sht1) & j).Value Then
totalMoney = totalMoney + sht1.Range(getColumnCode("含税金额", sht1) & j).Value
End If
Next
sht.Range(getColumnCode(rng1.Value, sht) & i).Value = totalMoney
End If
Next
i = i + 1
End If
Next
wb1.Close (False)
End Sub
'动态根据关键字列得到列号
Function getColumnCode(keyName As String, sht As Worksheet)
getColumnCode = Split(sht.Cells.Find(keyName, lookat:=xlWhole).Address(1, 0), "$")(0)
End Function
10)请将“试题十测试文件夹“中所有文件的数据汇总到” 测试题10_结果表”
- 要求:
-
a) 结果表需按班级、姓名、语文、数学、英语、总分(语文+数学+英语)列顺序进行输出
-
b) 输出结果需先按班级升序,再按总分降序进行排序
'练习题10-方法1
Sub MainTest10()
Application.ScreenUpdating = False
Dim wb As Workbook, sht As Worksheet, fileName As String, iRows As Integer, wb1 As Workbook, folder As String, iRows1 As Integer, sht1 As Worksheet, rng As Range, dynamicAddress As String, dynamicAddress1 As String, i As Integer
Set wb = Workbooks(ThisWorkbook.Name)
Set sht = wb.Worksheets("测试题10_结果表")
folder = ThisWorkbook.Path & "\试题十测试文件夹\"
iRows = sht.Range("A1").CurrentRegion.Rows.Count
sht.Range("A2:F" & iRows + 1).Clear
fileName = Dir(folder & "*.xls")
Do While fileName <> ""
iRows = sht.Range("A1").CurrentRegion.Rows.Count
Set wb1 = Workbooks.Open(folder & fileName)
Set sht1 = wb1.Sheets(1)
iRows1 = sht1.Range("A1").CurrentRegion.Rows.Count
For Each rng In sht.Range("A1:E1")
dynamicAddress = getColumnCode(rng.Value, sht)
dynamicAddress1 = getColumnCode(rng.Value, sht1)
sht1.Range(dynamicAddress1 & "2:" & dynamicAddress1 & iRows1).Copy sht.Range(dynamicAddress & iRows + 1)
Next
wb1.Close (False)
fileName = Dir
Loop
iRows = sht.Range("A1").CurrentRegion.Rows.Count
For i = 2 To iRows
sht.Range(getColumnCode("总分", sht) & i) = sht.Range(getColumnCode("语文", sht) & i) + sht.Range(getColumnCode("英语", sht) & i) + sht.Range(getColumnCode("数学", sht) & i)
Next
Call scoreSort(sht, iRows, getColumnCode("班级", sht), getColumnCode("总分", sht))
Application.ScreenUpdating = True
End Sub
'动态根据关键字列得到列号
Function getColumnCode(keyName As String, sht As Worksheet)
getColumnCode = Split(sht.Cells.Find(keyName, lookat:=xlWhole).Address(1, 0), "$")(0)
End Function
'班级总分排序
Function scoreSort(sht As Worksheet, iRows As Integer, column1 As String, column2 As String)
sht.Sort.SortFields.Clear
sht.Sort.SortFields.Add2 Key:=Range(column1 & "2:" & column1 & iRows), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
sht.Sort.SortFields.Add2 Key:=Range(column2 & "2:" & column2 & iRows), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
With sht.Sort
.SetRange Range(column1 & "1:" & column2 & iRows)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Function
四、数据源模板表下载
- 资源模板网盘路径如下:
VBA常见示例题.rar
提取码:t6vi