需求描述:
手动创建/刷新/生成报表后,从质量保证(Quality Assurance)的角度而言,必须进行可靠的自检。其实,在报表生成过程中,每一步操作都力求准确(通过VBA、SQL等自动化手段,尽量减少容易出错的人工操作),按道理走到最后报表出现问题的概率很低。所以,这里的自检主要是随机抽取两条新数据,和上期已交付的报表中的同一条key(full-key)的记录进行比较。正常情况下,不同期的数据差别不会太大(相同或者只有少数几条会变动),如果出现大量不一致,那肯定是报表出问题了(以前发生过,公式错位一行的问题,就是靠这种自检流程发现的)。所以,这里的测试相当于将报表交付给客户前的最后一道质量把关,有点像冒烟测试。
目前,自检通过手动查找、复制、粘贴完成,耗时至少3分钟。
通过本代码,这3分钟也可以省了。1年节省:3*12=36分钟,按一小时35美金计算,又节约了21美金/年,哈哈。
代码:
Sub autoValidation() ' ' Copy pre-delivery data to validation worksheet to compare it with previously delivered data (smoke test) ' Dim sourceUsedRows As Long '定义源数据区行数 Dim targetRow As Long '定义根据FULL_UKEY查询出的测试数据所在的行数 Dim sourcesht As Worksheet '定义源数据所在工作表 Dim targetsht As Worksheet '定义目标数据工作表 Set sourcesht = ThisWorkbook.Worksheets("Delivery") '指定源数据所在工作表 Set targetsht = ThisWorkbook.Worksheets("Validation") '指定目标数据工作表 Application.ScreenUpdating = False '不显示中间的操作过程 sourceUsedRows = sourcesht.UsedRange.Rows.Count '根据FULL_UKEY查询第一条测试数据并复制到Validation数据表相应位置 sourcesht.Select '如果不激活该工作表,程序运行到后面的sourcesht.Rows(targetRow).Select语句会出错 sourcesht.Range("A1:AE" & sourceUsedRows).AutoFilter Field:=22, Criteria1:= _ "udata1" '指定筛选条件,Field:=22表示工作表第22列(Full-key),Criteria1:指定具体查询条件(即,full-key) targetRow = sourcesht.AutoFilter.Range.Offset(2).SpecialCells(xlCellTypeVisible).Rows(1).Row '筛选结果所在行的行号 sourcesht.Rows(targetRow).Select '选择筛选结果所在行 Selection.Copy '复制整行 targetsht.Select '选择Validation工作表 targetsht.Range("B2").Select '转置、粘贴值到目标区域 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True sourcesht.ShowAllData '清除筛选器(filter) '根据FULL_UKEY查询第二条测试数据并复制到Validation数据表相应位置 sourcesht.Select sourcesht.Range("A1:AE" & sourceUsedRows).AutoFilter Field:=22, Criteria1:= _ "udata2" targetRow = sourcesht.AutoFilter.Range.Offset(2).SpecialCells(xlCellTypeVisible).Rows(1).Row sourcesht.Rows(targetRow).Select 'sourcesht.Range("L" & targetRow).Activate Selection.Copy targetsht.Select targetsht.Range("E2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True sourcesht.ShowAllData '清除筛选器(filter) targetsht.Range("D1,G1").Select '激活测试结果单元格,如果都是绿色而不是红色,恭喜!如果有红色,请查明原因! Application.ScreenUpdating = True '恢复显示中间的操作过程 End Sub