VBA:检查可选参数

Ale*_*lex 1 excel vba optional-parameters

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

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
Run Code Online (Sandbox Code Playgroud)

但是,有时我想在相同的范围内应用相同的例程,但使用不同的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
Run Code Online (Sandbox Code Playgroud)

这让我想知道:

我可以以某种方式告诉 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
Run Code Online (Sandbox Code Playgroud)

这需要大量的 if 语句,也是在另一个方向,( If NOT IsMissing(colNumber2) Then)。如果将两个以上的变量联系在一起,情况只会变得更糟。当一个值丢失时,我作为解决方法尝试的任何计算都会给我一个错误(“类型不匹配”),例如我尝试过:

If IsError(rowNumber2 * colNumber2) Then
   MsgBox "Error, please supply both rowNumber2 and colNumber2"
End If
Run Code Online (Sandbox Code Playgroud)

是否有本机功能?我想出的唯一解决方案是提供我知道不会“自然”发生的默认值:

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
Run Code Online (Sandbox Code Playgroud)

Mat*_*don 5

魔术默认值是一个坏主意。

您需要一个“代表需要始终放在一起的两个值的东西”的概念——这听起来很像需要某种Tuple封装两个值的对象;我会使用核强类型选项,并添加两个新的类模块 - 首先是一些通用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
Run Code Online (Sandbox Code Playgroud)

然后是一个RangeLocation实现它的类:

'@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
Run Code Online (Sandbox Code Playgroud)

请注意,该对象的实例不可能封装负行或列索引。现在我们可以这样做:

Dim a As ITuple
Set a = RangeLocation.Create(1, 1)
Run Code Online (Sandbox Code Playgroud)

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

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
Run Code Online (Sandbox Code Playgroud)

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

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

DoSomething source, _
    RangeLocation.Create(4, 2), _
    RangeLocation.Create(1, 1), _
    RangeLocation.Create(2, 2)
    '...
Run Code Online (Sandbox Code Playgroud)

如果调用者尝试这样做RangeLocation.Create(0, -12),则会出现运行时错误(因为类的Property Let成员RangeLocation不允许负值)并且DoSomething甚至不会被调用。