测试模块 VBA
Test Module VBA
我正在尝试编写一个测试模块来测试我在 VBA 中编写的模块之一。具体来说，我有一个 if 语句，我想通过给 module/funtion 错误的初始参数来触发使用测试模块。我要测试的 module/function 是：
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 argument type mismatch"。
请帮助我，我不知道我做错了什么。我已经成功安装了Rubberduck。
改变
Application.ActiveSheet.Range("A1:A5").Select
至
Application.ActiveSheet.Range("A1:A5")
函数TPR_TNR_FPR_FNR(expected_vals作为范围，pred_vals作为范围，
val_tested 作为整数) 作为双精度
expected_vals 是范围，pred_vals 是范围
但是 r1, r2 是变体。
所以类型不匹配。
首先，感谢您测试您的 VBA 代码。每种语言的专业开发人员都编写单元测试，并且 Rubberduck (disclaimer: I manage that project) you're stepping up your game and contributing to make VBA less of a dreaded language.
虽然并非所有代码都是可测试的。为了针对某个函数编写单元测试，该函数需要以 耦合 降至最低的方式编写，并且其 依赖性 理想情况下作为参数。
一件事 绝对使功能无法测试的是当该功能涉及用户交互时。 MsgBox 弹出一个需要手动关闭的模式 window，因此可测试代码避免了它 1。 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
请注意，这不会比较每个范围的行数 and/or 列； 只是它们有相同数量的非空单元格。就那一个 Err.Raise 语句，我可以想到要编写的几个单元测试：
- 给定具有相同数量非空单元格的相同大小范围，不会引发错误。
- 给定具有不同数量非空单元格的相同大小范围，将引发错误 5。
- 给定具有相同数量非空单元格的不同大小范围，不会引发错误。
- 给定具有不同数量非空单元格的不同大小范围，将引发错误 5。
- 给定具有相同数量非空单元格的非相邻区域，不会引发错误。
- 给定两个没有任何非空单元格的范围，不会引发错误。
如果这些语句中的任何一个看起来不正确，那么你的代码没有按预期工作 - 因为所有这些测试都会通过，因为当 WorksheetFunction.CountA returns a 时抛出错误两个范围的不同值。
通过了保护子句，函数继续迭代 expected_vals 中具有与 val_tested 参数匹配的值的单元格。
该函数正在处理 Range 个对象，迭代单元格，隐式比较 Range.[_Default] (Value) 与 Integer 值：如果 Range.[_Default] 中的任何单元格=29=] 包含错误，此处抛出 Type Mismatch 错误：
If cell = val_tested Then
因为上面真的是这样做的：
If cell.Value = val_tested Then
Range.Value 是一个可以包含任何值的 Variant：数值是 Variant/Double，所以即使在 "happy path" 中也有一个隐式转换正在进行，顺序将 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 会更 descriptive/meaningful 的名称，它应该在本地用 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
如果这是预期的，应该对其进行测试。否则，应该加以防范，代理值应该 returned（例如 -1 或 0），...并且应该对其进行测试！
- 如果
expected_vals 中没有单元格与提供的 val_tested 值匹配，则会抛出错误 11。
或者..
- 鉴于
expected_vals 中没有单元格与提供的 val_tested 值匹配，returns 0.
编写测试
对于上面的每一个 "Given..., ..." 项目符号，都应该编写一个测试来证明它。您的测试有很多 ，还有一些未识别的。
编写好的测试的秘诀在于控制输入。拥有 Excel.Range 参数使它变得比必要的更难：现在你需要进行一些测试 sheet 具有实际测试范围和一堆测试值，......这是一场噩梦，因为现在是否测试通过或失败取决于测试本身不包含的东西——这非常糟糕：好的测试应该有可靠的、可重现的、一致的结果。
我在该函数中没有看到任何说明它 需要 使用 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 的单元测试功能包括一个 "fakes" API 可以让你配置一个测试并从字面上劫持 MsgBox（以及其他几个) 调用，允许您为通常弹出消息框的过程编写测试，在测试 运行ning 时不显示它。 API 还允许您配置其 return 值，因此您可以例如测试当用户点击 "Yes" 时会发生什么，然后另一个测试可以确认当用户点击 "No".
时会发生什么
我正在尝试编写一个测试模块来测试我在 VBA 中编写的模块之一。具体来说，我有一个 if 语句，我想通过给 module/funtion 错误的初始参数来触发使用测试模块。我要测试的 module/function 是：
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 argument type mismatch"。 请帮助我，我不知道我做错了什么。我已经成功安装了Rubberduck。
改变
Application.ActiveSheet.Range("A1:A5").Select
至
Application.ActiveSheet.Range("A1:A5")
函数TPR_TNR_FPR_FNR(expected_vals作为范围，pred_vals作为范围， val_tested 作为整数) 作为双精度
expected_vals 是范围，pred_vals 是范围 但是 r1, r2 是变体。
所以类型不匹配。
首先，感谢您测试您的 VBA 代码。每种语言的专业开发人员都编写单元测试，并且 Rubberduck (disclaimer: I manage that project) you're stepping up your game and contributing to make VBA less of a dreaded language.
虽然并非所有代码都是可测试的。为了针对某个函数编写单元测试，该函数需要以 耦合 降至最低的方式编写，并且其 依赖性 理想情况下作为参数。
一件事 绝对使功能无法测试的是当该功能涉及用户交互时。 MsgBox 弹出一个需要手动关闭的模式 window，因此可测试代码避免了它 1。 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
请注意，这不会比较每个范围的行数 and/or 列； 只是它们有相同数量的非空单元格。就那一个 Err.Raise 语句，我可以想到要编写的几个单元测试：
- 给定具有相同数量非空单元格的相同大小范围，不会引发错误。
- 给定具有不同数量非空单元格的相同大小范围，将引发错误 5。
- 给定具有相同数量非空单元格的不同大小范围，不会引发错误。
- 给定具有不同数量非空单元格的不同大小范围，将引发错误 5。
- 给定具有相同数量非空单元格的非相邻区域，不会引发错误。
- 给定两个没有任何非空单元格的范围，不会引发错误。
如果这些语句中的任何一个看起来不正确，那么你的代码没有按预期工作 - 因为所有这些测试都会通过，因为当 WorksheetFunction.CountA returns a 时抛出错误两个范围的不同值。
通过了保护子句，函数继续迭代 expected_vals 中具有与 val_tested 参数匹配的值的单元格。
该函数正在处理 Range 个对象，迭代单元格，隐式比较 Range.[_Default] (Value) 与 Integer 值：如果 Range.[_Default] 中的任何单元格=29=] 包含错误，此处抛出 Type Mismatch 错误：
If cell = val_tested Then
因为上面真的是这样做的：
If cell.Value = val_tested Then
Range.Value 是一个可以包含任何值的 Variant：数值是 Variant/Double，所以即使在 "happy path" 中也有一个隐式转换正在进行，顺序将 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 会更 descriptive/meaningful 的名称，它应该在本地用 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
如果这是预期的，应该对其进行测试。否则，应该加以防范，代理值应该 returned（例如 -1 或 0），...并且应该对其进行测试！
- 如果
expected_vals中没有单元格与提供的val_tested值匹配，则会抛出错误 11。
或者..
- 鉴于
expected_vals中没有单元格与提供的val_tested值匹配，returns 0.
编写测试
对于上面的每一个 "Given..., ..." 项目符号，都应该编写一个测试来证明它。您的测试有很多
编写好的测试的秘诀在于控制输入。拥有 Excel.Range 参数使它变得比必要的更难：现在你需要进行一些测试 sheet 具有实际测试范围和一堆测试值，......这是一场噩梦，因为现在是否测试通过或失败取决于测试本身不包含的东西——这非常糟糕：好的测试应该有可靠的、可重现的、一致的结果。
我在该函数中没有看到任何说明它 需要 使用 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 的单元测试功能包括一个 "fakes" API 可以让你配置一个测试并从字面上劫持 MsgBox（以及其他几个) 调用，允许您为通常弹出消息框的过程编写测试，在测试 运行ning 时不显示它。 API 还允许您配置其 return 值，因此您可以例如测试当用户点击 "Yes" 时会发生什么，然后另一个测试可以确认当用户点击 "No".