首先，感谢您测试您的 VBA 代码。每种语言的专业开发人员都编写单元测试，并且使用Rubberduck（免责声明：我管理该项目），您正在加强您的游戏并为使 VBA 不再是一种可怕的语言做出贡献。
但并非所有代码都是可测试的。为了针对一个函数编写单元测试，该函数需要以这样一种方式编写，即耦合减少到最低限度，并且它的依赖关系理想地被作为参数。
绝对使功能无法测试的一件事是该功能涉及用户交互时。MsgBox弹出一个需要手动关闭的模态窗口，因此可测试代码避免它1。Stop是不应该在生产中的调试器代码，并且也阻止了测试的执行。
你被公共汽车撞了，或者继续在其他地方追求新的挑战，现在需要有人明天接管该代码。他们会诅咒你的名字，还是赞美你的工作？
我无法阅读TPR_TNR_FPR_FNR并立即弄清楚它的名称。这是一个问题，因为它使维护变得比它需要的要困难得多：如果我们不知道一个函数应该做什么，我们怎么知道它做对了？通过一套命名良好的测试，我们可以知道它在所有情况下的行为......假设命名良好的测试。Test1并没有告诉我们太多，除了它正在测试一些东西。
首先放弃MsgBoxandStop语句 - 在那个保护子句中抛出一个错误：
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是 aVariant可以保存任何值：数值是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的单元格的数量实际上也是如此：我相信这将是一个更具描述性/意义的名称，并且应该使用声明在本地声明它（Rubberduck 检查应该警告你它。 . 和其他几件事）。expected_valsval_testedmatchingExpectedValuesCountDim
接下来我们有一个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
最后，如果为 0，则函数结果的赋值将引发除以零错误count_all：
TPR_TNR_FPR_FNR = count_correct / count_all
如果这是预期的，则应该对其进行测试。否则，它应该被提防，应该返回一个代理值（例如 -1 或 0），......并且应该对其进行测试！
- 如果没有单元格
expected_vals与提供的val_tested值匹配，则会引发错误 11。
或者..
- 如果没有单元格
expected_vals与提供的val_tested值匹配，则返回 0。
编写测试
对于上面的每一个“给定...，...”项目符号，都应该编写一个测试来证明它。您的测试有许多已经确定的问题，也有许多未确定的问题。
编写好的测试的秘诀是控制输入。拥有Excel.Range参数会使事情变得比必要的更难：现在您需要一些具有实际测试范围和一堆测试值的测试表，......这是一场噩梦，因为现在测试是通过还是失败取决于't 在测试本身 - 这很糟糕：好的测试应该有可靠、可重复、一致的结果。
我没有在该函数中看到任何说它需要使用Range参数的东西。事实上，使用普通数组会显着提高效率，并且更容易断言保护子句中的假设 - 只需检查数组边界！使用普通数组也意味着测试现在可以自包含：测试设置代码可以轻松定义测试数组以提供函数，特别是因为我们已经确定这些数组需要是一维的。
因此，需要重写该函数才能使用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，给定两个不同大小的数组：如果没有引发预期的错误，则测试失败。如果是，则测试通过。
另一个测试可以验证在给定一个单元格中的错误值的情况下是否引发了错误 13 - 这里是一个#N/A单元格错误值：
'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% 清楚所有内容的目的，所以我留下了许多标识符，但我强烈建议重命名它们。
1 Rubberduck 的单元测试功能包括一个“假”API，它允许您配置测试并从字面上劫持MsgBox（以及其他几个）调用，允许您为通常弹出消息框的过程编写测试，而无需在测试时显示它正在运行。API 还允许您配置其返回值，因此您可以例如测试用户单击“是”时会发生什么，然后另一个测试可以确认用户单击“否”时会发生什么。