Supprimer ou ajouter dans un array avec facilité

Commenter

Contenu du snippet

Ce code montre comment on peut facilement intervenir sur un array d'éléments pour :
- supprimer un élément par son index ou par son contenu, sans bouleverser l'ordre des éléments
- ajouter un élément à un array et lui attribuer un index précis, sans bouleverser l'ordre des autres éléments
- déterminer l'index d'un élément à partir de son contenu

Le tout : sans parcourir en boucle les lignes de l'array traité, ni même le redimensionner (ni redim, ni redim reserve).
On traite aussi facilement qu'on le ferait en traitant une collection.

NOTA : le présent code (inédit à ma connaissance) est libre d'utilisation, à la seule condition de laisser les 3 lignes de commentaire, figurant en tête du module, qui précise qu'il est déposé sur VBFrance.

Source / Exemple : 


'===============================dans un module standard(VBA) ou .bas (VB6)===============================

Option Explicit
'===== le présent code, déposé par ucfoutu sur VBFrance, est la seule propriété de VBFrance
'=====VBFrance en autorise les libres copie et utilisation à la seule condition d'y laisser 
'=====insérées les trois présentes lignes commentées
Public Sub supprime_index(ByRef ARRAY_A_TRAITER, INDEX_ou_texte_element_A_SUPPRIMER)
  Dim I As Long, Sucf As String
  If VarType(INDEX_ou_texte_element_A_SUPPRIMER) = 8 Then
    Sucf = INDEX_ou_texte_element_A_SUPPRIMER
    I = ucfI(ARRAY_A_TRAITER, Sucf)
  Else
    I = INDEX_ou_texte_element_A_SUPPRIMER
  End If
  If I >= 0 Then ARRAY_A_TRAITER = ucfS(ARRAY_A_TRAITER, I)
End Sub
Public Sub ajoute_index(ByRef ARRAY_A_TRAITER, VALEUR_A_AJOUTER As String, INDEX_A_ATTRIBUER_A_CETTE_VALEUR As Long)
  ARRAY_A_TRAITER = ucfA(ARRAY_A_TRAITER, VALEUR_A_AJOUTER, INDEX_A_ATTRIBUER_A_CETTE_VALEUR)
End Sub
Public Function retourne_index(ByVal ARRAY_A_TRAITER, CHAINE_CONCERNEE As String) As Long
   retourne_index = ucfI(ARRAY_A_TRAITER, CHAINE_CONCERNEE)
End Function
Private Function ucfS(Aucf, Iucf) As Variant
  Dim Sucf As String
  Aucf(Iucf) = ""
  Sucf = Join(Aucf, Chr(0))
  If Iucf = 0 Then Sucf = Mid(Sucf, 2)
  If Iucf = UBound(Aucf) Then Sucf = Left(Sucf, Len(Sucf) - 1)
  ucfS = Split(Replace(Sucf, Chr(0) & Chr(0), Chr(0)), Chr(0))
End Function

Private Function ucfA(Aucf, qucf As String, Iucf As Long) As Variant
  If Iucf = UBound(Aucf) + 1 Then
     Aucf(Iucf - 1) = Aucf(Iucf - 1) & Chr(0) & Chr(0)
  Else
     Aucf(Iucf) = Chr(0) & Chr(0) & Aucf(Iucf)
  End If
  Aucf = Split(Replace(Join(Aucf, Chr(0)), Chr(0) & Chr(0), Chr(0)), Chr(0))
  Aucf(Iucf) = qucf
  ucfA = Aucf
End Function
Private Function ucfI(Aucf, Cucf As String) As Long
      Dim I As Long, Sucf As String
      Sucf = Chr(0) & Join(Aucf, Chr(0)) & Chr(0)
      I = InStr(Sucf, Chr(0) & Cucf & Chr(0))
      If I = 0 Then ucfI = -1: Exit Function
      Sucf = Mid(Sucf, 1, I)
      ucfI = UBound(Split(Sucf, Chr(0))) - 1
      If ucfI < 0 Then ucfI = -1
End Function

'======================================exemples d'utilisation ==================================
Private Sub CommandButton1_Click()
  'pour supprimer un élément (par son index ou par son contenu)
  Dim toto
  toto = Array("bonjour tout le monde", "salut les potes", "ciao", "voilà", "bye")
  
  supprime_index toto, 2 '_________________
 'ou                                       | les deux fonctionnent
  'supprime_index toto, "ciao" '___________|
 
  For I = 0 To UBound(toto) '___________
    MsgBox toto(I) '                     |====>> preuve
  Next '_________________________________|
End Sub

Private Sub CommandButton2_Click()
  'pour ajouter un élément et lui attribuer un index
  Dim toto
  toto = Array("bonjour tout le monde", "salut les potes", "ciao", "voilà", "bye")
  ajoute_index toto, "Il fait beau", 2
   For I = 0 To UBound(toto) '____________
   MsgBox toto(I) '                       |====>> preuve
  Next '__________________________________|

End Sub

Private Sub CommandButton3_Click()
  'pour déterminer l'index d'un élément dont on connait le contenu
  Dim toto
  Dim resul As Long
  toto = Array("bonjour tout le monde", "salut les potes", "ciao", "voilà", "bye")
  resul = retourne_index(toto, "salut les potes")
  MsgBox resul
End Sub

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (ucfoutu)