VBA: 检查可选参数

Question

我有两个潜艇，想将值从一个传递到另一个。

Option Explicit

Sub Test()
    Call HandleInput(ActiveSheet.Range("A1:C4"), 4, 2)
End Sub

Sub HandleInput(rng As Range, rowNumber As Long, colNumber As Long)
    Debug.Print rng.Cells(rowNumber, colNumber).Value
End Sub

然而，有时我想在相同的范围内应用相同的例程，但使用不同的 rownumber 和不同的 colnumber。我可以用新值再次调用 sub，现在这似乎是迄今为止最简单的选择，但我仍然想知道是否有一种聪明的方法可以使用 HandleInput 中的可选参数来处理它：

Sub HandleInput(rng As Range, rowNumber As Long, colNumber As Long, Optional rowNumber2 As Long, _
Optional colNumber2 As Long, Optional rowNumber3 As Long, Optional colNumber3 As Long)
   ...
End Sub

这让我想知道：

我能否以某种方式告诉 VBA，如果提供 rowNumber2，还需要传递 colNumber2 的值？我知道我可以尝试使用 IsMissing() 并将数据类型切换为 Variant：

Sub HandleInput(rng As Range, rowNumber As Long, colNumber As Long, Optional rowNumber2 As Variant, 
     _ Optional colNumber2 As Variant, Optional rowNumber3 As Variant, Optional colNumber3 As Variant)
          If Not IsMissing(rowNumber2) Then
              If IsMissing(colNumber2) Then
                   MsgBox "Please enter a value for colNumber2."
                   End
              End If
          End If
End Sub

这需要很多 if 语句，反之亦然 (If NOT IsMissing(colNumber2) Then)。如果将两个以上的变量联系在一起，情况只会变得更糟。当缺少一个值时，我尝试作为解决方法的任何计算都会给我一个错误 ("Type mismatch")，例如我试过：

If IsError(rowNumber2 * colNumber2) Then
   MsgBox "Error, please supply both rowNumber2 and colNumber2"
End If

有这方面的原生功能吗？我想到的唯一解决方案是提供我知道不会出现的默认值 "naturally":

Sub HandleInput(rng As Range, rowNumber As Long, colNumber As Long, Optional rowNumber2 As Long = -100, _
Optional colNumber2 As Long = -100, Optional rowNumber3 As Long = -100, Optional colNumber3 As Long = -100)

     If rowNumber2 = -100 Or colNumber2 = -100 Then
        MsgBox "Please enter a value for both rowNumber2 and colNumber2."
        End
    End If
End Sub

Answer 1

你可以用 ParamArray 处理整个事情并检查输入数组的范围

Sub HandleInput(rng As Range, ParamArray RCPairs() As Variant)

    If UBound(RCPairs) < 1 Then
        Err.Raise 513, "HandleInput", "Please enter at least one pair of RowNumber, ColNumber."
    ElseIf UBound(RCPairs) Mod 2 = 0 Then
        Err.Raise 513, "HandleInput", "Please enter a value for both RowNumber and ColNumber."
    End If

    ' ...

End Sub

这样调用

Sub Demo()
    HandleInput SomeRange, r1, c1, r2, c2 ' Works

    HandleInput SomeRange ' Error "Please enter at least one pair of RowNumber, ColNumber."

    HandleInput SomeRange, r1, c1, r2, c2, x ' Error: "Please enter a value for both RowNumber and ColNumber."

End Sub

注意：我将您的 MsgBox、End 更改为引发错误，因此您的调用代码可以决定如何处理该错误。顺便说一句，使用 End 是不明智的，see here

Answer 2

神奇的默认值不是个好主意。

你需要一个 "something that represents two values that need to always go together" 的概念——这听起来很像需要某种封装了两个值的 Tuple 对象；我会选择核强类型选项，并添加两个新的 class 模块——首先是一些通用的 ITuple 接口：

'@Interface
Option Explicit

Public Property Get Item1() As Variant
End Property

Public Property Get Item2() As Variant
End Property

Public Function ToString() As String
End Function

然后 RangeLocation class 实现它：

'@PredeclaredId 'see https://github.com/rubberduck-vba/Rubberduck/wiki/VB_Attribute-Annotations
Option Explicit
Implements ITuple

Private Type TInternal
    RowIndex As Long
    ColumnIndex As Long
End Type

Private this As TInternal

Public Function Create(ByVal atRow As Long, ByVal atColumn As Long) As ITuple
    Dim result As RangeLocation
    Set result = New RangeLocation
    result.RowIndex = atRow
    result.ColumnIndex = atColumn
    Set Create = result
End Function

Public Property Get RowIndex() As Long
    RowIndex = this.RowIndex
End Property

Public Property Let RowIndex(ByVal value As Long)
    If value <= 0 Then Err.Raise 5
    this.RowIndex = value
End Property

Public Property Get ColumnIndex() As Long
    ColumnIndex = this.ColumnIndex
End Property

Public Property Let ColumnIndex(ByVal value As Long)
    If value <= 0 Then Err.Raise 5
    this.ColumnIndex = value
End Property

Private Property Get ITuple_Item1() As Variant
    ITuple_Item1 = this.RowIndex
End Property

Private Property Get ITuple_Item2() As Variant
    ITuple_Item2 = this.ColumnIndex
End Property

Private Function ITuple_ToString() As String
    ITuple_ToString = "R" & this.RowIndex & "C" & this.ColumnIndex
End Function

请注意，不可能拥有封装负行或负列索引的对象实例。现在我们可以这样做了：

Dim a As ITuple
Set a = RangeLocation.Create(1, 1)

这意味着我们也可以这样做：

Public Sub DoSomething(ByVal source As Range, ParamArray values() As Variant)
    Dim i As Long
    For i = LBound(values) To UBound(values)

        Dim location As ITuple
        Set location = values(i)

        On Error Resume Next
        Debug.Print source.Cells(location.Item1, location.Item2).Value
        If Err.Number <> 0 Then Debug.Print "Location " & location.ToString & " is outside the specified source range."
        On Error GoTo 0

    Next
End Sub

...现在其他人的工作是确保他们提供有效的值 - 更准确地说，这是调用代码的工作：

Dim source As Range
Set source = ActiveSheet.Range("A1:C4")

DoSomething source, _
    RangeLocation.Create(4, 2), _
    RangeLocation.Create(1, 1), _
    RangeLocation.Create(2, 2)
    '...

如果调用者试图做RangeLocation.Create(0, -12)，将会出现运行时错误（因为RangeLocationclass的Property Let成员不允许负值) 和 DoSomething 甚至不会被调用。

VBA: 检查可选参数

VBA: Checking optional parameters

excel

vba

optional-parameters