测试模块VBA

Question

我正在尝试编写一个测试模块来测试我在VBA中编写的模块之一.具体来说,我有一个if语句,我希望通过给模块/功能提供错误的初始参数来触发测试模块.我想测试的模块/功能是:

Function TPR_TNR_FPR_FNR(expected_vals As Range, pred_vals As Range, 
val_tested As Integer) As Double

If WorksheetFunction.CountA(expected_vals) <> 
WorksheetFunction.CountA(pred_vals) Then
   MsgBox "Cells in Expected_vals and pred_vals must be the same in length"
   Stop
End If

count_all = 0
For Each cell In expected_vals
  If cell = val_tested Then
    count_all = count_all + 1
  End If
Next cell

count_correct = 0
For i = 1 To expected_vals.Cells.Count
  If (expected_vals.Cells(i).Value = pred_vals.Cells(i).Value) And 
(expected_vals.Cells(i).Value = val_tested) Then
     count_correct = count_correct + 1
  End If
Next

TPR_TNR_FPR_FNR = count_correct / count_all

End Function

我的测试模块是:

 '@TestModule
 Private Assert As Rubberduck.AssertClass

 '@TestMethod
 Public Sub Test1()
 'Arrange
 Const expected As String = "Cells in Expected_vals and pred_vals must be 
 the same in length"
 Dim actual As String

 'Act
 Dim r1, r2 As Variant
    r1 = 
 WorksheetFunction.Transpose(Application.ActiveSheet.Range("A1:A5").Select)
    r2 = 
 WorksheetFunction.Transpose(Application.ActiveSheet.Range("B1:B4").Select)
 actual = Module1.TPR_TNR_FPR_FNR(r1, r2, 0)

 'Assert
 Assert.AreEqual expected, actual, "Expected MsgBox not received"
 End Sub

但是,当测试脚本变为"actual = ..."时,我得到r1变量的错误"Byref参数类型不匹配".请帮助我,我不知道我做错了什么.我已经成功安装了Rubberduck.

Answer 1

首先,用于测试您的VBA代码的荣誉.每种语言的专业开发人员都会编写单元测试,而使用Rubberduck(免责声明:我管理该项目),你正在加强游戏,并使VBA不再是一种可怕的语言.

但并非所有代码都是可测试的.为了针对函数编写单元测试,需要以这样的方式编写该函数,即将耦合减少到最小,并且理想地将其依赖性作为参数.

绝对使函数不可测试的One Thing就是当该函数涉及用户交互时.MsgBox弹出一个需要手动关闭的模态窗口,因此可测试的代码可以避免它¹.Stop是不应该在生产中的调试器代码,并且也阻止执行测试.

你被一辆公共汽车击中,或继续在其他地方寻求新的挑战,现在有人需要明天接管这些代码.他们会诅咒你的名字,还是赞美你的工作？

我无法阅读TPR_TNR_FPR_FNR并立即通过其名称弄清楚它的作用.这是一个问题,因为它使维护变得比它需要的更难:如果我们不知道一个函数应该做什么,我们怎么知道它做得对呢？通过一系列名称齐全的测试,我们可以知道它在所有情况下的行为......假设命名良好的测试.Test1并没有告诉我们太多,除了它正在测试的东西.

首先抛弃MsgBox和Stop声明 - 在该保护条款中抛出一个错误:

If WorksheetFunction.CountA(expected_vals) <> WorksheetFunction.CountA(pred_vals) Then
    Err.Raise 5, "TPR_TNR_FPR_FNR", "Cells in Expected_vals and pred_vals must be the same in length"
End If

请注意,这不会比较每个范围的行数和/或列数; 只是他们拥有相同数量的非空单元格.就这一个Err.Raise声明而言,我可以想到要写几个单元测试:

• 给定具有相同数量的非空单元的相同大小范围,不会引发错误.
• 给定具有不同数量的非空单元的相同大小范围,抛出错误5.
• 给定具有相同数量的非空单元的不同大小范围,不会引发错误.
• 给定具有不同数量的非空单元的不同大小范围,抛出错误5.
• 给定具有相同数量的非空单元的非相邻范围,不会引发错误.
• 给定两个没有任何非空单元格的范围,不会抛出任何错误.

如果这些语句中的任何一个看起来不正确,那么您的代码就不能按预期工作 - 因为所有这些测试都会通过,因为在WorksheetFunction.CountA为两个范围返回不同的值时会抛出错误.

通过了保护子句,函数继续迭代expected_vals具有与val_tested参数匹配的值的单元格.

该函数正在处理Range对象,迭代单元格,隐式地比较Range.[_Default](Value)与Integer值:如果任何单元格expected_vals包含错误,则抛出类型不匹配错误:

If cell = val_tested Then

因为上面的确是这样做的:

If cell.Value = val_tested Then

Range.Value是一个Variant可以保存任何值的数字:数值是Variant/Double,所以即使在"快乐路径"中也会进行隐式转换,以便将其Double与提供的进行比较Integer.看起来val_tested应该是一个Double.

但Range.Value也可以Variant/Error,并且该变体子类型不能与任何其他类型进行比较而不会抛出类型不匹配.如果预计会抛出那种类型的不匹配,那么应该对它进行测试.否则,它应该被处理 - 然后应该测试它:

• 给定错误值expected_vals,抛出错误13(或不？)

如果不应该发生该错误,那么该函数需要主动阻止它:

For Each cell In expected_vals
    If Not IsError(cell.Value) Then
        If cell.Value = val_tested Then count_all = count_all + 1
    End If
Next

因此count_all,其中的单元格数量的expected_vals值与提供的val_tested参数相匹配:我相信matchingExpectedValuesCount它将是一个更具描述性/意义的名称,它应该在本地Dim声明一个语句(Rubberduck检查应该警告你.以及其他几件事.

接下来我们有For一个令人惊讶的假设的循环:

For i = 1 To expected_vals.Cells.Count
    If (expected_vals.Cells(i).Value = pred_vals.Cells(i).Value) And (expected_vals.Cells(i).Value = val_tested) Then

我们现在假设所提供的范围具有非常特定的形状.如果我们用2列范围或非连续的多区域范围做到这一点,那么我们就会爆炸.

保护条款需要防范该假设,并相应地抛出错误.WorksheetFunction.CountA/每个提供范围内的非空单元格数量不足以正确防止不良输入.这样的事情应该更准确:

If expected_vals.Rows.Count <> pred_vals.Rows.Count _
    Or expected_vals.Columns.Count <> 1 _
    Or pred_vals.Columns.Count <> 1 _
Then
    Err.Raise 5, "TPR_TNR_FPR_FNR", "Invalid inputs"
End If

现在的假设是:

• 给定具有相同数量单元的相同大小范围,不会引发错误.
• 给定具有不同数量的单元的相同大小的范围,抛出错误5.
• 给定具有相同数量单元的不同大小范围,抛出错误5.
• 给定具有不同数量的单元的不同大小范围,抛出错误5.
• 给定具有相同数量的非空单元的非相邻范围,抛出错误5.
• 给定两个没有任何非空单元格的范围,不会抛出任何错误.

现在解决了这个问题,第二个循环也必须处理Variant/Error以防止类型不匹配错误.

If Not IsError(expected_vals.Cells(i).Value) _
    And Not IsError(pred_vals.Cells(i).Value) _
Then
    If (expected_vals.Cells(i).Value = pred_vals.Cells(i).Value) And (expected_vals.Cells(i).Value = val_tested) Then
        count_correct = count_correct + 1
    End If
End If

最后,如果count_all为0 ,函数结果的赋值将抛出除零误差:

TPR_TNR_FPR_FNR = count_correct / count_all

如果是这样的话,应该对它进行测试.否则,它应该被防范,应该返回一个代理值(例如-1或0),......并且应该对它进行测试!

• 如果没有expected_vals匹配提供的val_tested值的单元格,则抛出错误11.

要么..

• 如果没有expected_vals匹配提供的val_tested值的单元格,则返回0.

写测试

对于上面的每一个"给...,......"子弹,应该编写一个测试来证明它.您的测试有许多已经确定的问题,以及一些未经识别的问题.

写好测试的秘诀在于控制输入.拥有Excel.Range参数使得它变得比必要更难:现在你需要有一些带有一堆测试值的实际测试范围的测试表,......这是一场噩梦,因为现在测试通过还是失败取决于那些不是在测试本身 - 这是非常糟糕的:良好的测试应该具有可靠,可重复,一致的结果.

我没有看到该函数中的任何内容表明它需要使用Range参数.事实上,使用普通数组会使它显着提高效率,并且更容易在guard子句中断言假设 - 只需检查数组边界!使用普通数组也意味着测试现在可以自包含:测试设置代码可以轻松定义测试数组以提供函数,特别是因为我们已经确定这些数组需要是1维的.

因此需要重写函数以使用Variant数组.

一旦完成(我将把那部分留给你!),你可以轻松地为所有测试设置所有必需的输入,而Rubberduck的测试模板使这相当容易.以下是其中一项测试的结果:

'@TestMethod
Public Sub GivenDifferentSizeArrays_Throws()
    Const ExpectedError As Long = 5
    On Error GoTo TestFail

    'Arrange:
    Dim expectedValues As Variant
    expectedValues = Array(1, 2, 3)

    Dim predValues As Variant
    predValues = Array(1, 2, 3, 4)

    'Act:
    Dim result As Double
    result = TPR_TNR_FPR_FNR(expectedValues, predValues, 1)

Assert:
    Assert.Fail "Expected error was not raised."

TestExit:
    Exit Sub
TestFail:
    If Err.Number = ExpectedError Then
        Resume TestExit
    Else
        Resume Assert
    End If
End Sub

这个测试(请注意,它需要修改函数以获取两个变量数组,而不是Range参数)期望函数调用引发错误5,给定两个不同大小的数组:如果未引发预期错误,则测试失败.如果是,则测试通过.

另一个测试可以验证在其中一个#N/A单元格中给出错误值时抛出错误13 - 这里是单元错误值:

    'Arrange:
    Dim expectedValues As Variant
    expectedValues = Array(1, 2, 3)

    Dim predValues As Variant
    predValues = Array(CVErr(xlErrNA), 2, 3)

等等,直到所有可以考虑的边缘情况都被覆盖:如果您的测试都有意义地命名,您可以通过简单地阅读Rubberduck的测试资源管理器中的测试名称,只需单击一下,就可以准确了解您的函数的行为方式.运行整个套件,看到它们全部变为绿色,证明该功能完全符合预期 - 即使您对其进行了更改.

明确假设

这是您的函数的重写版本,它使其假设明确,​​并且应该更容易编写测试:

Public Function TPR_TNR_FPR_FNR(ByRef expected_vals As Variant, ByRef pred_vals As Variant, ByVal val_tested As Double) As Double

    Dim workValues As Variant
    Dim predValues As Variant

    If Not IsArray(expected_vals) Or Not IsArray(pred_vals) Then
        Err.Raise 5, "TPR_TNR_FPR_FNR", "Parameters must be arrays."
    Else
        workValues = expected_vals
        predValues = pred_vals
    End If

    If TypeOf expected_vals Is Excel.Range Then
        If expected_vals.Columns.Count <> 1 Then Err.Raise 5, "TPR_TNR_FPR_FNR", "'expected_vals' must be a single column."
        workValues = Application.WorksheetFunction.Transpose(expected_vals)
    End If

    If TypeOf pred_vals Is Excel.Range Then
        If pred_vals.Columns.Count <> 1 Then Err.Raise 5, "TPR_TNR_FPR_FNR", "'pred_vals' must be a single column."
        predValues = Application.WorksheetFunction.Transpose(pred_vals)
    End If

    If UBound(workValues) <> UBound(predValues) Then
        Err.Raise 5, "TPR_TNR_FPR_FNR", "'expected_vals' and 'pred_vals' must be the same size."
    End If

    Dim matchingExpectedValuesCount As Long
    Dim currentIndex As Long
    For currentIndex = LBound(workValues) To UBound(workValues)
        If workValues(currentIndex) = val_tested Then
            matchingExpectedValuesCount = matchingExpectedValuesCount + 1
        End If
    Next

    If matchingExpectedValuesCount = 0 Then
        TPR_TNR_FPR_FNR = 0
        Exit Function
    End If

    Dim count_correct As Long
    For currentIndex = LBound(predValues) To UBound(predValues)
        If workValues(currentIndex) = predValues(currentIndex) And workValues(currentIndex) = val_tested Then
            count_correct = count_correct + 1
        End If
    Next

    TPR_TNR_FPR_FNR = count_correct / matchingExpectedValuesCount

End Function

请注意,我并不是100%清楚所有内容的目的,所以我已经留下了许多标识符 - 我会热烈建议重命名它们.

¹ Rubberduck的单元测试功能包括一个"假货"API,可让您配置测试和字面上劫持MsgBox(和其他几个)调用,允许您为通常弹出消息框的过程编写测试,而不会在测试时显示它正在运行.API还允许您配置其返回值,因此您可以测试用户单击"是"时发生的情况,然后另一个测试可以确认用户单击"否"时会发生什么.