学以致用——使用VBA进行自动化测试（Auto validation/smoke test with VBA）

需求描述：

手动创建/刷新/生成报表后，从质量保证（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