VBA: проверка дополнительных параметров

У меня есть два сабвуфера и хочу передать значения от одного к другому.

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

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

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

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

Всего 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

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


Магические настройки по умолчанию - плохая идея.

Вы нуждаетесь в понятии «что-то, что представляет два значения, которые должны всегда идти вместе» - это очень похоже на необходимость какого-то объекта Tuple который инкапсулирует два значения; Я бы ITuple ядерную строго типизированную опцию и добавил два новых модуля класса - сначала какой- ITuple универсальный интерфейс 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) попытается выполнить RangeLocation.Create(0, -12) , произойдет ошибка времени выполнения (поскольку члены Property Let класса RangeLocation не допускают отрицательных значений), а DoSomething даже не будет вызываться.