Suppression éléments de variable tableau en VBA

[Polo34]

Bonjour le Forum et excellente année 2013 à tous

Je souhaite votre aide concernant un pb de suppression d"éléments dans une variable tableau obtenue à partir d'une feuille excel.
En fait (voir fichier joint), je crée un tableau à partir d'une zone de cellules contenue dans la feuille "temp".
Je souhaite extraire du tableau obtenu, tous les éléments dont la date est différente de 2012. et recopier le nouveau tableau dans une feuille nommée "data".
Hors quand je lance la commande REDIM PRESERVE sur le tableau après suppression d'un élément, j'ai un message d'erreur.
Pourriez vous m'éclairer sur ce point.
J'ai l'impression de mal gérer cette commande pour un tableau à 2 dimensions.

Merci d'avance.

Polo34

 

[camarchepas]

Re : Suppression éléments de variable tableau en VBA

Bonjour, Polo,

Je pense que tu vas être obligé de passer par un tableau intermédiaire, car tu ne peux pas ajuster dans ce sens.

 

[Pierrot93]

Re : Suppression éléments de variable tableau en VBA

Bonjour,

regarde peut être ceci :

Sub test()
Dim i As Integer, x As Integer
Dim a(), b()

Set f1 = Sheets("Temp")
Set f2 = Sheets("data")
ln1 = f1.Range("A65000").End(xlUp).Row
ln2 = f2.Range("A65000").End(xlUp).Row
f2.Visible = True
'effacer données de la feuilles "data"
f2.Select
Range("A2:d" & ln2 + 1).Delete
ln2 = f2.Range("A65000").End(xlUp).Row

f1.Select
a = f1.Range("A2:D" & ln1).Value

For i = 1 To UBound(a)
    If Year(a(i, 3)) <> "2012" Then
        For u = i + 1 To UBound(a)
            For t = 1 To 4
                a(u - 1, t) = a(u, t)
            Next t
        Next u
        x = x + 1
    End If
Next i

a = Application.Transpose(a)
ReDim Preserve a(LBound(a, 1) To UBound(a, 1), LBound(a, 2) To UBound(a, 2) - x)
a = Application.Transpose(a)

End Sub

bon après midi
@+

 

[Dranreb]

Re : Suppression éléments de variable tableau en VBA

Bonsoir.
Essayez ma version, comme ça:

Sub test()
Dim T() As Variant, Le As Long, Ls As Long, C As Long
With Worksheets("Temp"): T = .Range("A2:D" & .[A65000].End(xlUp).Row).Value: End With
For Le = 1 To UBound(T)
   If Year(T(Le, 3)) = "2012" Then
      Ls = Ls + 1: If Ls < Le Then For C = 1 To 4: T(Ls, C) = T(Le, C): Next C
      End If
   Next Le
With Worksheets("Data")
   .[A2:D65000].ClearContents
   .[A2].Resize(Ls, 4).Value = T
   End With
End Sub

Cordialement.

 

[Efgé]

Re : Suppression éléments de variable tableau en VBA

Bonjour à tous et bonne année à chacun , Une version sans tableau. Cordialement

 

[Polo34]

Re : Suppression éléments de variable tableau en VBA

Bonjour à tous et bonne année à chacun , Une version sans tableau. Cordialement

Merci à tous pour vos réponses avec de plus des solutions différentes et instructives
A+
Polo34

 

[BOISGONTIER]

Re : Suppression éléments de variable tableau en VBA

Bonjour,

Il me semble que Transpose() pose un pb si la taille du tableau dépasse 65000.

Sub supLignesRapideTableau()
  Application.ScreenUpdating = False
  Set f1 = Sheets("Temp")
  Set f2 = Sheets("data")
  a = f1.Range("A2:D" & f1.[A65000].End(xlUp).Row).Value
  Dim c()
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  ligne = 1
  For i = LBound(a) To UBound(a)
    If Year(a(i, 3)) <> 2012 Then
      For k = 1 To UBound(a, 2): c(ligne, k) = a(i, k): Next k
      ligne = ligne + 1
    End If
  Next
  f2.[A2].Resize(ligne, UBound(a, 2)) = c
End Sub

Si on veut conserver la présentation

Sub supLignesRapide()
  Application.ScreenUpdating = False
  a = Range("C2:C" & [C65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If Year(a(i, 1)) <> 2012 Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B2].Resize(UBound(a)) = a
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub

JB