Excel : Copier des cellules liées Résolu

Question

Bonjour,

Je bloque actuellement sur Excel et j'aimerai un petit coup de pouce si c'est possible.

Je souhaiterai une macro qui tout d'abord supprime les valeurs 0 dans une colonne, puis qui décalle les cellules vers le haut du nombre de 0 supprimé. Mais que lors de ce décallage les données situé dans la colonne de droite soit copier aussi.

Voici un exemple pour mieux comprendre, je pense :
Données          Résultats
2      MM              2       MM
0                         4       MM
4      MM              8
0      MM              6
0
0
8
6

Emilie

Configuration: Windows XP / Internet Explorer 6.0

EmilieM · Answer

Données		Résultats	
2	MM	2	MM
0		4	MM
4	MM	8	
0	MM	6	
0			
0			
8			
6

EmilieM · Answer

Désolé pour l'exemple je n'arrive pas à le mettre en forme....

eriiic · Answer

Bonjour, 

Malgré ton exemple je pense avoir compris : 
Sub supp() 
    Dim lig As Long 
    For lig = [A65536].End(xlUp).Row To 2 Step -1 
        If Cells(lig, 1) = 0 Then Cells(lig, 1).Resize(1, 2).Delete Shift:=xlUp 
    Next lig 
End Sub
La prochaine fois tu peux déposer un fichier sur cijoint.fr et coller ici le lien fourni 

eric

edit : et merci d'éviter les doublons : voir ici

EmilieM · Answer

Merci,
C'est exactement ce que je souhaitai faire.

EmilieM · Answer

Oups, j'ai parlé un peu trop vite comme toujours...
En fait cette macro fonctionne trés bien sur une dizaine de données mais je travaille actuellement avec plus de 20 000 valeurs dans la colonne A sachant que dans celle ci il doit y avoir au mloins 10 000 zéro.
Et lorsque je lance la macro sur mes 20 000 valeurs le processus est trop long et mon ordi plante.
Donc te serait il possible d'avoir la méme chose mais applicable à un nombre plus important de valeurs?

Emilie

eriiic · Answer

Il ne plante pas, mais c'est long et il faut attendre...
Cette version sera plus rapide mais pareil, laisse la finir...
Sub supp() 
    Dim lig As Long 
    application.screenupdating = false
    For lig = [A65536].End(xlUp).Row To 2 Step -1 
        If Cells(lig, 1) = 0 Then Cells(lig, 1).Resize(1, 2).Delete Shift:=xlUp 
    Next lig 
    application.screenupdating = true
End Sub

eric

Emilie.M · Answer

Ok, je vais la tester sur mes valeurs.
Merci.

EmilieM · Answer

Oui, cette version fonctionne également mais elle est trop longue à tourner.
En effet, elle met bien 1h avant d'afficher les résultats. 
Est ce que l'un d'entre vous n'aurez pas une idée pour accélérer d'avantage le processus?

Emilie

michel_m · Answer

Bonjour Emilie, Eric, Mike 

en me basant sur ce que j'ai pigé 
la colonne B est remplie avec les données de la colonne A sans les zéros (version Mike?)? 

Si oui sur 20000 lignes en moins d'une seconde 
Sub lister_sans_0() 
Dim derlig As Long 
Dim tablo 

derlig = Range("A65536").End(xlUp).Row 
ReDim tablo(0) 

For Cptr = 1 To derlig 
If Cells(Cptr, 1) <> 0 Then 
    tablo(cptr_T) = Cells(Cptr, 1) 
    cptr_T = cptr_T + 1 
    ReDim Preserve tablo(cptr_T) 
End If 
Next 

Columns(2).ClearContents 
Range("B1").Resize(cptr_T + 1, 1) = Application.Transpose(tablo) 
     
End Sub

tite démo 
https://www.cjoint.com/?egj4m5sSHS 

en esperant ne pas ^tre à coté de la plaque mais je doute... 

eddit: on pourrait encore aller + vite avec un screenupdating oublié...


:-x

EmilieM · Answer

Non ce n'est pas exactement ce que tu subjére. En fait j'ai 2 colonnes A et B avec dans la colonne A des 0 et d'autres valeurs. Je souhaiterai que la macro supprime les 0 en décallant les cellules vers le haut du nombre de 0 supprimer tout en gardant le contenu de la cellule situé en colonne B qui li est associé.
Par exemple en A2 j'ai 2, en A3 - 0 et en A4 - 6 avec en B3 - MM et en B4 - MM. Je voudrai obtenir en A2 - 2 et B2 -    ; A3 - 6 et B3 - MM.
J'espére que mes explications seront suffisantes.
Emilie

EmilieM · Answer

https://www.cjoint.com/?eglKaTCuu5

Voici le lien contenant l'exemple, avec en colonne A et B les données sources et en colonne C et D ce que je souhaiterai obtenir.

En espérant que cela soit compréhensible!

Emilie.

michel_m · Answer

en espèrant que... temps <= 2 secondes


Sub lister_sans_0()
Dim derlig As Integer, cptr As Integer, cptr_t As Integer
Dim tablo

'initialisations
derlig = Range("A65536").End(xlUp).Row
ReDim tablo(1, 0)

'colecte des données
For cptr = 2 To derlig
If Cells(cptr, 1) <> 0 Then
    tablo(0, cptr_t) = Cells(cptr, 1)
    tablo(1, cptr_t) = Cells(cptr, 2)
    cptr_t = cptr_t + 1
    ReDim Preserve tablo(1, cptr_t)
End If
Next

'restitution
Application.ScreenUpdating = False
Range("C2:D30000").ClearContents
Range("C2").Resize(cptr_t + 1, 2) = Application.Transpose(tablo)
 Application.ScreenUpdating = True

End Sub

et la demo chronm^tre:
https://www.cjoint.com/?egmodTCzxR

Tu dis...

EmilieM · Answer

Génial sa marche.

Un grand grand merci à toi cela fonctionne trés bien et en méme pas 2 secondes d'ailleurs..... 
Bonne continuation à tous ceux qui m'ont apportés leurs aides.

Emilie.

Excel : Copier des cellules liées

13 réponses

Votre réponse

Newsletters