Excel: Passer un tableau dans une fonction définie par l'utilisateur?

Question

Comment passer un tableau en tant que paramètre pour une fonction définie par l'utilisateur dans MS Excel VBA?

Finalement, je veux vérifier que si une date donnée (dateDay) est dans plusieurs gammes de dates (arrayVacation):

Function CB_IsInRangeArr(dateDay As Date, ParamArray arrayVacation() As Variant) As Boolean 

    ' Test that the array is in the form of 2 columns and n rows/if not send back an error 
    If (UBound(arrayVacation, 1) <> 2) Then 
     CB_IsInRangeArr = CVErr(xlErrNA) 
    Else 
     CB_IsInRangeArr = TRUE 
    End If 
End Function 

Pourtant, déjà à ce stade, la fonction ne fonctionne pas correctement. Il renvoie #VALUE!

Answer 1

OK, j'ai ajouté une fonction

Public Function CB_IsInRangeArr(c As Date, range As range) As Boolean 
Dim iRow As Integer 

    For iRow = 1 To range.Rows.Count 
     Dim startDate As Date, endDate As Date 
     startDate = range.Cells(iRow, 1) 
     endDate = range.Cells(iRow, 2) 
     If (startDate <= c And endDate >= c) Then 
      CB_IsInRangeArr = True 
      Exit Function 
     End If 
    Next iRow 
End Function 

ce qui vous permet d'ajouter les plages de dates, et une cellule pour la date à vérifier.

alors la formule dans la cellule est

=CB_IsInRangeArr(C1,A1:B2) 

avec c1 étant la date à vérifier, et a1: b2 les plages de dates.

Veuillez demander si je peux aider plus loin.

Answer 2

Paramarray crée un tableau de variantes à chaque élément tenant le paramètre: Essayez quelque chose comme ça

Function CB_IsInRangeArr(dateDay As Date, ParamArray arrayVacation() As Variant) As Variant 

    Dim nParams As Long 
    Dim vRangeValues As Variant 
    Dim jParam As Long 
    Dim j As Long 

    nParams = UBound(arrayVacation) - LBound(arrayVacation) + 1 
    If nParams &le 0 Then Exit Function 
    On Error GoTo Fail 

    For jParam = LBound(arrayVacation) To UBound(arrayVacation) 

     vRangeValues = arrayVacation(jParam).Value 

     For j = LBound(vRangeValues) To UBound(vRangeValues) 
      If (vRangeValues(j, 1) &le dateDay And vRangeValues(j, 2) &ge dateDay) Then 
       CB_IsInRangeArr = True 
       Exit Function 
      End If 
     Next j 

    Next jParam 

    Exit Function 
Fail: 
    CB_IsInRangeArr = CVErr(xlErrNA) 
End Function