2015-12-11 23 views
7

Czy istnieje sposób usunięcia pierwszego elementu tablicy w VBA?Usuń pierwszy element tablicy VBA

Coś jak metoda 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 

to returing błąd: Subscript out of range

Odpowiedz

8

Nie ma bezpośredni sposób w VBA, ale można łatwo usunąć pierwszy element tak:

'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

Chociaż jest to dobra odpowiedź, a ja ją stosuję jako taką, być może zauważysz, że jeśli celem jest posiadanie czegoś w rodzaju kolejki, byłby to strasznie nieefektywny sposób na jej wdrożenie. Kod, który intensywnie wykorzystuje takie rzeczy, prawdopodobnie powinien zostać zmodyfikowany, aby go nie wymagać. –

+0

Zauważ, że istnieje 0 element, więc 'Dla każdego' zawsze zgłasza coś dla pierwszego (zerowego) elementu. – rheitzman

+0

"My"? Komentarz prawdopodobnie powinien być w OP. – rheitzman

4

Nie ma niestety. Musisz napisać metodę, aby to zrobić. Dobrym przykładem jest 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

Jeśli chcesz włączyć ten podprogram w swoim kodzie "tak jak jest", uważaj, aby zmienić 'lTop' na' UBound (ItemArray) ' – lucam

2

nie odpowiedź, ale badania na tablicy adresowania.

Kod: ReDim Zachowanie matriz (1) matriz (1) = 5

tworzy tablicę z dwóch elementów: 0 i 1 Ubound() zwraca 1

Oto kodami może pomóc zbadać problem:

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 
Powiązane problemy