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). И это только ухудшается, если более двух переменных должны быть связаны вместе. Любое вычисление, которое я пытаюсь использовать в качестве обходного пути, выдает ошибку («Несоответствие типов»), когда отсутствует одно значение, например, я пытался:

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

Есть ли для этого встроенная функция? Единственное решение, которое я придумал, - это ввести значения по умолчанию, которые, как я знаю, не будут происходить «естественно»:

Answer 1

Magi c значения по умолчанию - плохая идея.

Вам нужна концепция "нечто, представляющее два значения, которые должны всегда go вместе" - это звучит очень сильно например, нужен какой-то объект Tuple, который инкапсулирует два значения; Я бы go с опцией ядерного типа со строгим типом и добавил два новых модуля класса - сначала какой-нибудь универсальный 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, который его реализует :

'@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), произойдет ошибка времени выполнения (поскольку члены Property Let класса RangeLocation не не допускайте отрицательных значений) и DoSomething даже не будет вызываться.

Answer 2

Вы можете обработать целую головку с помощью 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

Примечание: I пометил ваши MsgBox, End на выдачу ошибки, чтобы ваш вызывающий код мог решить, что делать с ошибкой. Кстати, использование End неразумно, см. Здесь