Suppression éléments de variable tableau en VBA

  • Initiateur de la discussion Initiateur de la discussion Polo34
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Polo34

XLDnaute Junior
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
 

Pièces jointes

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

Bonjour,

regarde peut être ceci :
Code:
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
@+
 
Re : Suppression éléments de variable tableau en VBA

Bonsoir.
Essayez ma version, comme ça:
VB:
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.
 
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.

Code:
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

Code:
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
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
2 K
Retour