2015-12-11 14 views
7

C'è un modo per rimuovere il primo elemento di un array in VBA?Rimuovere il primo elemento di un array VBA

Qualcosa come javascript shift() metodo?

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 

Questo è returing l'errore: Subscript out of range

risposta

8

Non v'è alcun metodo diretto in VBA, ma è possibile rimuovere il primo elemento facilmente in questo modo:

'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) 
+4

Sebbene questa sia una buona risposta e io la sto revocando come tale, si potrebbe forse osservare che se l'obiettivo è avere qualcosa come una coda, allora questo sarebbe un modo terribilmente inefficiente per implementarlo. Il codice che fa un uso pesante di cose come questa dovrebbe probabilmente essere modificato in modo da non richiederlo. –

+0

Si noti che c'è un elemento 0 in modo che 'For Each' riporterà sempre qualcosa per il primo (0 °) elemento. – rheitzman

+0

"Noi"? Il commento probabilmente avrebbe dovuto essere sull'OP. – rheitzman

4

Non c'è purtroppo. Devi scrivere un metodo per farlo. Un buon esempio è 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 
+0

Se si desidera incorporare questa subroutine nel proprio codice "così com'è", fare attenzione a cambiare 'lTop' in' UBound (ItemArray) ' – lucam

2
Non

una risposta, ma uno studio sulla matrice di indirizzamento.

Questo codice: ReDim Preserve matriz (1) matriz (1) = 5

Crea una matrice con due elementi: 0 e 1 UBound() restituisce 1

Ecco un codice che può aiutare ad esplorare il problema:

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 

out:

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 
Problemi correlati