Supprimer un élément d'un tableau sur VBA

Bonjour à tous,

J'ai une liste de "visiteurs", le visiteur "A" est le premier visiteur et se situe en A5, le "B" en A6 ... et ainsi de suite jusqu'à R en A22.

J'ai écrit un bout de code pour créer un tableau avec ces visiteurs puis j'appelle suppElmt() pour supprimer le visiteur 10 et redimensionner mon tableau en conséquence. Cependant en exécutant mon code il bloque à la ligne ReDim Preserve TB(i) de suppElmt() et me met Run-time error '9' : subscript out of range. Je n'arrive pas à comprendre pourquoi. Pouvez-vous m'aider s'il vous plaît ?

Voici mon code :

Option Explicit

Sub créer_tab()

    Dim tableau_visiteurs()
    Dim visiteur As Integer
    Dim nbVisiteurs As Integer
    Dim lastRow As Integer
    Dim i As Integer

    'nb de visiteurs
    lastRow = Range("A5").End(xlDown).Row
    nbVisiteurs = lastRow - 4

    'Remplit le tableau des visiteurs
    For i = 1 To nbVisiteurs
        ReDim Preserve tableau_visiteurs(1 To i)
        tableau_visiteurs(i) = Cells(i + 4, 1)
    Next i

    'Supprime le visiteur 10
    visiteur = 10
    Call SuppElmt(tableau_visiteurs(), visiteur)

End Sub

Sub SuppElmt(TB(), elmt As Integer)
    Dim i As Integer
    For i = elmt To UBound(TB) - 1
        TB(i) = TB(i + 1)
    Next i
    i = i - 1
    ReDim Preserve TB(i)
End Sub

Merci beaucoup.

Clara

Bonjour Clara, bonjour le forum,

Peut-être comme ça :

Option Explicit
Private tableau_visiteurs()

Sub créer_tab()
Dim visiteur As Integer
Dim nbVisiteurs As Integer
Dim lastRow As Integer
Dim i As Integer

'nb de visiteurs
lastRow = Range("A5").End(xlDown).Row
nbVisiteurs = lastRow - 4
'Remplit le tableau des visiteurs
For i = 1 To nbVisiteurs
    ReDim Preserve tableau_visiteurs(1 To i)
    tableau_visiteurs(i) = Cells(i + 4, 1)
Next i
'Supprime le visiteur 10
visiteur = 10
Call SuppElmt(tableau_visiteurs(), visiteur)
End Sub

Sub SuppElmt(TB(), elmt As Integer)
Dim i As Integer
Dim J As Integer
Dim NT() As Variant

ReDim NT(1 To UBound(TB) - 1)
J = 1
For i = 1 To UBound(TB)
    If i <> elmt Then
        NT(J) = TB(i)
        J = J + 1
    End If
Next i
tableau_visiteurs() = NT()
'Range("C5").Resize(UBound(NT)) = Application.Transpose(tableau_visiteurs)
End Sub

Bonjour ThauThème,

Merci beaucoup pour le coup de pouce, ça marche !

Bonjour et bienvenue sur le forum

Essaie comme ça :

Option Explicit

Dim tableau_visiteurs, TB()
Dim i&, k&

Sub créer_tab()

    'Dim tableau_visiteurs()
    Dim visiteur As Integer
    Dim nbVisiteurs As Integer
    Dim lastRow As Integer
    Dim i As Integer

    'nb de visiteurs
    lastRow = Range("A5").End(xlDown).Row
    nbVisiteurs = lastRow - 4

    'Remplit le tableau des visiteurs
    'For i = 1 To nbVisiteurs
        'ReDim Preserve tableau_visiteurs(1 To i)
        'tableau_visiteurs(i) = Cells(i + 4, 1)
    'Next i
     tableau_visiteurs = Range("A5:A" & lastRow)

    'Supprime le visiteur 10
    visiteur = 10
    Call SuppElmt '(tableau_visiteurs(), visiteur)

    Range("A5:A" & lastRow).ClearContents
    Range("A5").Resize(UBound(TB, 2), 1) = Application.Transpose(TB)
End Sub

Sub SuppElmt()  '(TB(), elmt As Integer)

    k = 0
    For i = 1 To UBound(tableau_visiteurs, 1)
        If i <> 10 Then
            ReDim Preserve TB(1 To 1, 1 To k + 1)
            TB(1, k + 1) = tableau_visiteurs(i, 1)
            k = k + 1
        End If
    Next i

    'Dim i As Integer
    'For i = 1 To UBound(TB) - 1
        'TB(i) = TB(i + 1)
    'Next i
    'i = i - 1
    'ReDim Preserve TB(i)
End Sub

Résultat ?

Bye !