web-dev-qa-db-fra.com

Supprimer le premier élément d'un tableau VBA

Est-il possible de supprimer le premier élément d'un tableau dans VBA?

Quelque chose comme la méthode javascript shift()?

Option Explicit

Sub Macro1()
Dim matriz() As Variant
Dim x As Variant
matriz = Array(0)

ReDim Preserve matriz(1)
matriz(1) = 5
ReDim Preserve matriz(2)
matriz(2) = 10
ReDim Preserve matriz(3)
matriz(3) = 4

ReDim Preserve matriz(1 To UBound(matriz))

For Each x In matriz
    Debug.Print x
Next x
End Sub

Ceci retient l'erreur: Subscript out of range

arraysexcelvbaexcel-vba
9
Nuno Nogueira

Il n'y a pas de méthode directe dans VBA, mais vous pouvez facilement supprimer le premier élément comme ceci: 

'Your existing code
'...
'Remove "ReDim Preserve matriz(1 To UBound(matriz))"
For i = 1 To UBound(matriz)
  matriz(i - 1) = matriz(i)
Next i
ReDim Preserve matriz(UBound(matriz) - 1)
11
ManishChristian

Il n'y en a malheureusement pas. Vous devez écrire une méthode pour le faire. Un bon exemple est http://www.vbforums.com/showthread.php?562928-Remove-Item-from-an-array

'~~> Remove an item from an array, then resize the array

    Public Sub DeleteArrayItem(ItemArray As Variant, ByVal ItemElement As Long)
    Dim i As Long

    If Not IsArray(ItemArray) Then
      Err.Raise 13, , "Type Mismatch"
      Exit Sub
    End If

    If ItemElement < LBound(ItemArray) Or ItemElement > UBound(ItemArray) Then
      Err.Raise 9, , "Subscript out of Range"
      Exit Sub
    End If

    For i = ItemElement To lTop - 1
      ItemArray(i) = ItemArray(i + 1)
    Next
    On Error GoTo ErrorHandler:
    ReDim Preserve ItemArray(LBound(ItemArray) To UBound(ItemArray) - 1)
    Exit Sub
    ErrorHandler:
    '~~> An error will occur if array is fixed
    Err.Raise Err.Number, , _
    "Array not resizable."

    End Sub
5
justkrys

Pas une réponse mais une étude sur l'adressage en tableau. 

Ce code: ReDim Conserver matriz (1) Matriz (1) = 5

Crée un tableau avec deux éléments: 0 et 1 UBound () renvoie 1

Voici un code qui peut aider à explorer le problème:

Option Explicit

Sub Macro1()
   Dim matriz() As Variant
   Dim x As Variant
   Dim i As Integer
   matriz = Array(0)

   ReDim Preserve matriz(1)
   matriz(1) = 5
   ReDim Preserve matriz(2)
   matriz(2) = 10
   ReDim Preserve matriz(3)
   matriz(3) = 4

   Debug.Print "Initial For Each"
   For Each x In matriz
       Debug.Print ":" & x
   Next x
   Debug.Print "Initial For i = 0"
   For i = 0 To UBound(matriz)
       Debug.Print ":" & matriz(i)
   Next i
   Debug.Print "Initial For i = 1"
   For i = 1 To UBound(matriz)
       Debug.Print ":" & matriz(i)
   Next i
   Debug.Print "remove one"

   For i = 1 To UBound(matriz)
     matriz(i - 1) = matriz(i)
   Next i
   ReDim Preserve matriz(UBound(matriz) - 1)

   For Each x In matriz
       Debug.Print ":" & x
   Next x

   Debug.Print "remove one more"
   For i = 1 To UBound(matriz)
     matriz(i - 1) = matriz(i)
   Next i
   ReDim Preserve matriz(UBound(matriz) - 1)

   For Each x In matriz
       Debug.Print ":" & x
   Next x
End Sub

En dehors:

Initial For Each
:0
:5
:10
:4
Initial For i = 0
:0
:5
:10
:4
Initial For i = 1
:5
:10
:4
remove one
:5
:10
:4
remove one more
:10
:4
2
rheitzman

Pas de méthode directe, mais un peu de contournement sans boucles :-)

Cette approche utilise une plage cible intermédiaire pour 

  • [1] recevoir les données du tableau (en commençant par exemple par la cellule A10) et
  • .... les récupérer en tant que champ de données à 2 dimensions redimensionné (en comptant à partir de la cellule A11 en omettant ainsi le premier élément) et
  • [2] transposez-le dans un tableau plat à une dimension

Exemple de code 

Option Explicit

Sub Macro1()
'Method: use temporary target range to restructure array
 Dim matriz() As Variant
 Dim rng      As Range
'[0.1] Assign same data set to array as in original post
 matriz = Array(0, 5, 10, 4)
          Debug.Print "a) original matriz(" & LBound(matriz) & " To " & UBound(matriz) & ")", Join(matriz, ", ")
'instead of:
'  ReDim Preserve matriz(0 To 3)
'  matriz(0) = 0: matriz(1) = 5: matriz(2) = 10: matriz(3) = 4

'[0.2] Set temporary range to memory
 Set rng = ThisWorkbook.Worksheets("Tabelle1").Range("A10").Resize(UBound(matriz) + 1, 1)
'[1] Write array data to range and reassign to matriz cutting first row
 rng = Application.Transpose(matriz)                    ' fill in array data (transposed to column)
 matriz = rng.Offset(1, 0).Resize(UBound(matriz), 1)    ' assign data to (2-dim) array omitting first row
'[2] Transpose back to flat 1-dim array
 matriz = Application.Transpose(Application.Index(matriz, 0, 1))
          Debug.Print "b) ~~>  new matriz(" & LBound(matriz) & " To " & UBound(matriz) & ")", Join(matriz, ", "),

End Sub

Exemple de sortie dans la fenêtre immédiate de VBE (Debug.Print) 

a) original matriz(0 To 3)  0, 5, 10, 4
b) ~~>  new matriz(1 To 3)  5, 10, 4

Lien associé

Puis-je retourner un tableau basé sur 0 à partir de ws.UsedRange?

1
T.M.

Si vous avez un tableau de chaînes, vous pouvez rejoindre, décaler et fractionner à nouveau.

Public Sub test()

    Dim vaSplit As Variant
    Dim sTemp As String

    Const sDEL As String = "||"

    vaSplit = Split("1 2 3 4", Space(1))
    sTemp = Join(vaSplit, sDEL)

    vaSplit = Split(Mid$(sTemp, InStr(1, sTemp, sDEL) + Len(sDEL), Len(sTemp)), sDEL)

    Debug.Print Join(vaSplit, vbNewLine)

End Sub

Résultats

2
3
4
1
Dick Kusleika

Ce qui suit est une fonction "Shift", qui se comporte comme la méthode shift dans JS, et un exemple d'utilisation de "Shift"

Sub tryShift()

Dim aRy As Variant, sT As Variant

aRy = Array("one", "two", "three", "four")

Debug.Print "Original array:"
For Each sT In aRy
Debug.Print sT
Next

aRy = Shift(aRy)

Debug.Print vbCrLf & "Array having been " & Chr(34) & "shifted" & Chr(34) & ":"
For Each sT In aRy
Debug.Print sT
Next

End Sub

Function Shift(aRy As Variant)

Dim iCt As Integer, iUbd As Integer

iCt = 0
iUbd = UBound(aRy)

Do While iCt < iUbd
    aRy(iCt) = aRy(iCt + 1)
    iCt = iCt + 1
Loop

ReDim Preserve aRy(UBound(aRy) - 1)

Shift = aRy

End Function

Sortie:

Original array:
one
two
three
four

Array having been "shifted":
two
three
four
0
jwf3148