Attribute VB_Name = "Retirer_Si_Existe_v101"

'----------------------------------------------------------------------------------------
' Procédure_____: Retirer_Si_Existe
' Date__________: 07/01/2022
' Auteur________: www.CapLSS.com - https://www.caplss.com/viewtopic.php?t=270
' Objet_________: Retire un élément connu d'un Tableau
' Référence_____: Fonction de conversion
' Appel_________: Nombre = Retirer_Si_Existe (x_LaValeur, x_LeTableau, opt. x_Vide)
' Retour________: Retourne 1 si retrait réalisé, 0 sinon
' Options_______: Si x_Vide := true, considère un champ vide comme valeur possible
' Compatibilité_: (2003-2019)Office     (11.0-16.0)Excel     (+)32-bit     (+)64-bit
' Statut________: (x)Validé ()En attente validation ()En cours développement
'----------------------------------------------------------------------------------------
' 2013.02.16 v1.00 DEV Création initiale, retire un élément non-vide d'un Tableau
' 2022.01.07 v1.01 DEV Accepte une chaine vide comme un élément officiel
'
Option Explicit
 
Function Retirer_Si_Existe(x_LaValeur As Variant, x_LeTableau As Variant, Optional x_Vide As Boolean) As Variant
  ' Si non-vide ou vide à gérer
  If (x_LaValeur = "" And x_Vide) Or x_LaValeur <> "" Then
   ' Si Nouveau ?
   Dim i, j As Variant
   Dim Y_Est As Boolean
   Y_Est = False
   For i = LBound(x_LeTableau) To UBound(x_LeTableau)
     'trouvé ?
     If x_LeTableau(i) = x_LaValeur Then
       Y_Est = True
       Exit For
     End If
   Next i
   ' Retire ou Pas
   If Y_Est Then
     For j = i To UBound(x_LeTableau) - 1
       x_LeTableau(j) = x_LeTableau(j + 1)
     Next j
     If (LBound(x_LeTableau) = UBound(x_LeTableau)) Then
     ' Dernier élément, tableau vide
       ReDim x_LeTableau(0)
     Else
     ' suppression de l'élément final en trop
       ReDim Preserve x_LeTableau(UBound(x_LeTableau) - 1)
     End If
     Retirer_Si_Existe = 1
   Else
     Retirer_Si_Existe = 0
   End If
  Else
     ' vide = ignoré
     Retirer_Si_Existe = 0
  End If
End Function