Effacer cellules vides dans les colonnes

Question

J'ai une feuille qui contient beaucoup de données et je doit effacer les cellules vides et déplacer les colonnes entre des lignes précises vers la gauche. J'utilise le code suivant mais c'est très lent. Set rng = Feuil1.Range(Feuil1.Cells(Feuil1.Range("A4").Row, Feuil1.Range("A4" ).Column), Feuil1.Cells(9800, 21)) rng.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft Comment remplacer le SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft Y-a-t-il une façon de faire plus rapide. Merci, Oiseau bleu...

LouReeD · Accepted Answer

Essayez ceci : remplacez : ' si on a incrit une donnée, alors on passe à la ligne suivante du tableai résultat If Inscrit Then Lr = Lr + 1 Next I par : ' si on a incrit une donnée, alors on passe à la ligne suivante du tableai résultat If Inscrit Then Lr = Lr + 1 Inscrit = False Erase TabS Next I Je viens de me faire un fichier de plus de 17700 lignes en copiant collant les données de votre fichier exemple et sur 24 colonnes et cela fonctionne avec ou sans le Erase. Le Inscrit = False permet de supprimer les lignes vides sur la feuille résultat. Le fichier : @ bientôt LouReeD...

LouReeD · Answer

Le soucis de la suppression vers la gauche, c'est qu'il y a déplacement des cellules "entières" avec mise en forme etc. Si une cellule sur la gauche d'une ligne est vide, est-ce les cellules qu'il faut déplacer ou bien les données ? Si ce n'est que les données alors par VBA et quelques boucle cela devrait être plus rapide. On récupère les données de D4:U9800 dans un tableau VBA. On boucle chaque ligne de ce tableau et on rempli un tableau Résultat qui par ligne ne comporte pas de cellule vide "à gauche". On efface les données de D4:U9800. On "injecte" le tableau résultat sur la feuille à partir de D4. Tout ceci se déroulera en mémoire vive sans accès feuille du coup c'est beaucoup plus rapide ! Et pour que cela soit encore plus rapide, un petit fichier exemple serait le bien venu. Maintenant s'il faut garder les mise en forme des cellules... @ bientôt LouReeD...

LouReeD · Answer

Voici le résultat, c'est quasi instantané, mais ceci supprime les mise en forme, chaque donnée est une donnée en dur.

Le fichier :

3colonnes-lrd.xlsm (39.85 Ko)

un bouton sur votre feuille source, un résultat sur la feuille LRD. Ouverture du fichier sur LRD pour montrer qu'elle est vide.

Avec ce système peu importe si les colonnes de données changent, puisque l'on supprime les cellules vides.
Le code est commenté a minima, si vous avez des question n'hésitez pas.

@ bientôt

LouReeD

LouReeD · Answer

Avez vous fait le pas à pas pour connaitre la ligne qui provoque l'erreur ? Sinon, au lieu de jouer avec un tableau à deux dimensions, où apparemment dans votre cas VBA ne sait pas gérer la taille à cause du grand nombre de cellule, on pourrait faire un tableau avec autant de tableau que de lignes de votre feuille source et ensuite on rempli un tableau résultat contenant autant de tableaux que de lignes. Cette erreur peut également venir par un manque de mémoire disponible, donc opération à faire sans rien d'autre à tourner sur l'ordinateur... J'attends de connaitre si l'erreur vient de UsedRange ou bien d'ailleurs... Vous pouvez par sécurité définir le I et le J en "As Long" @ bientôt LouReeD...

LouReeD · Answer

Essayez ce code :

Sub Contract2()
    Dim TabS(), TabR(), I As Long, J As Long, NbLigne As Long, NbColonne As Long
    Dim Cr As Long

    NbLigne = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
    NbColonne = ActiveSheet.UsedRange.Columns.Count

    ReDim TabR(1 To NbLigne, 1 To NbColonne)
    Lr = 1
    For I = 1 To NbLigne
        TabS = Range(Cells(I, 1), Cells(I, NbColonne))
        Cr = 1
        For J = 1 To NbColonne
            If TabS(1, J) <> "" Then
                ' on inscrit la donnée dans le tableau résultat
                TabR(Lr, Cr) = TabS(1, J)
                Cr = Cr + 1 'on prépare l'écriture de la prochaine donnée même ligne colonne suivante
                ' on a inscrit au moins une donnée sur la ligne Lr du tableau résultat
                Inscrit = True
            End If
        Next J
        ' si on a incrit une donnée, alors on passe à la ligne suivante du tableai résultat
        If Inscrit Then Lr = Lr + 1
    Next I
    Sheets("LRD").Range("A1").Resize(UBound(TabR), NbColonne) = TabR

End Sub

En fait il découpe la feuille source en ligne, et chaque ligne résultat est un tableau, ensuite il copie colle le tableau résultat.
Comme cela on a pas à mettre la totalité des cellules de votre plage.

Merci de votre retour. Si vous avez besoin de précisions...

@ bientôt

LouReeD

LouReeD · Answer

Merci pour votre retour et remerciement ! Bon courage pour la suite de votre projet. @ bientôt LouReeD...