XL 2016 Copier des valeurs et les coller dans une autre colonne

oles · 11 Mai 2021

Bonjour,

J'ai réalisé une macro qui marche... mais qui prend bien 1/2 heure à se terminer (car il y a pas loin de 6000 lignes à copier et à coller dans une autre colonne).

Il s'agit de copier des "comptes comptables" de la colonne "D" et les coller dans la colonne B chaque fois que les lignes de la colonne "D" = 0. Dans la colonne B, on fait l'inverse de la colonne D (voir exemple saisi à la main dans le fichier en PJ).

Les comptes sont copiés et collés de manière chronologique (comme un plan comptable).

Est-ce que quelqu'un aurait une autre idée de boucle, qui prendrait moins de temps ?

Merci par avance,

Etoto · 11 Mai 2021

Bonjour,

Je suis pourris en VBA donc c'est pas moi qui vais pouvoir t'aider, mais ce que je sais du VBA ce qu'il peux très vite changer selon le fichier, je pense que le mieux serait de nous montrer un échantillon du fichier en PJ (sans les données confidentielles).

Etoto · 11 Mai 2021

Ou alors tu nous montres le code VBA comme ça on voit déjà un peux plus clair, parce que je sais qu'enlever les données confidentielles d'un fichier comptable c'est pas le plus facile.

oles · 11 Mai 2021

Bonjour Etoto,

J'avais oublié la PJ. La macro s'appelle petite valeur. Il y a seulement qu'une partie de données (je ne vais pas mettre tout le compte de résultat analytique ;-D)

Etoto · 11 Mai 2021

Alors je vais laisser la place au experts désormais.

Phil69970 · 11 Mai 2021

Bonjour @oles , @Etoto

Ce code remplace avantageusement ton code et il prends moins de 3 s sur mon micro....
Code supprimé et remplacé par le code du post #7 suite à une erreur

@Phil69970

Phil69970 · 11 Mai 2021

Bonjour @oles , @Etoto

J'ai fait une erreur dans mon code précèdent je te propose ce nouveau code:
==> Moins de 1 seconde sur 6000 lignes

VB:

Sub Compte_Analytique_compte() ' ONGLET BALANCE_ANA.COMPTES
Application.ScreenUpdating = False
Dim Derlig&, cptr$
cptr = 0
With Feuil1
    Derlig = .Range("D" & Rows.Count).End(xlUp).Row
    .Range("B3:B" & Derlig).ClearContents
    For i = Derlig To 3 Step -1
    Select Case .Range("D" & i).Value
        Case Is > 0
            .Range("B" & i).Value = ""
            cptr = .Range("D" & i).Value
        Case 0
            .Range("B" & i).Value = cptr
    End Select
    Next i
End With
End Sub

@Phil69970

oles · 12 Mai 2021

Phil69970 à dit:

Bonjour @oles , @Etoto

J'ai fait une erreur dans mon code précèdent je te propose ce nouveau code:
==> Moins de 1 seconde sur 6000 lignes

VB:

Sub Compte_Analytique_compte() ' ONGLET BALANCE_ANA.COMPTES
Application.ScreenUpdating = False
Dim Derlig&, cptr$
cptr = 0
With Feuil1
    Derlig = .Range("D" & Rows.Count).End(xlUp).Row
    .Range("B3:B" & Derlig).ClearContents
    For i = Derlig To 3 Step -1
    Select Case .Range("D" & i).Value
        Case Is > 0
            .Range("B" & i).Value = ""
            cptr = .Range("D" & i).Value
        Case 0
            .Range("B" & i).Value = cptr
    End Select
    Next i
End With
End Sub

J'ai testé la macro. Elle fonctionne. Par contre sur mon fichier original elle met bien 15 minutes. Je me demande si c'est pas mon PC (j'entends le ventilateur qui s'enclenche quand j'exécute la macro) ou alors la taille du fichier original (2.36 Mo).
En tout cas. Merci beaucoup pour l'alternative.
Je ne comprends pas vraiment la ligne "cptr = .Range("D" & i).Value". Ce serait un compteur ?

Phil69970 · 12 Mai 2021

Bonjour @oles

oles à dit:
Par contre sur mon fichier original elle met bien 15 minutes.

Combien de lignes as tu sur ton vrai fichier ?
Cptr est le nom d'une variable j'aurais pu l'appeler "Toto" ou "Stockage" mais c'est le nom qui m'est venu à l'esprit car dans un autre post je devais compter combien de fois un nombre était dans une liste d’où cptr.

En gros si il y a un nombre > 0 dans la cellule Dx alors Bx = vide et je stocke ce nombre dans cptr.
Si = 0 dans la cellule Dx alors Bx = la valeur de cptr

@Phil69970

oles · 12 Mai 2021

J'ai 6003 lignes.
Mais comme dit, sur la maquette, cela fonctionne bien. C'est exactement ce que je souhaitais.

Phil69970 · 12 Mai 2021

@oles

J'ai fait un test sur 100 000 lignes en moins de 10 s sur mon PC
Manifestement il y a un pb sur le fichier

@Phil69970

soan · 12 Mai 2021

Bonjour Phil, oles,

tu as écrit : « Manifestement il y a un pb sur le fichier » ; alors peut-être que ma solution avec la méthode des tableaux marchera mieux pour le fichier réel du demandeur oles ?

@oles : ton fichier en retour ; fais Ctrl e ➯ travail effectué ! pour info, la méthode des tableaux fait que c'est vraiment très rapide, même sur plusieurs milliers de lignes.

EDIT : ne PAS prendre le fichier et le code VBA de ce post, car j'avais très mal compris ce qu'il fallait faire : je croyais qu'il fallait inverser les colonnes B et D, mais ce n'est pas du tout ça ! je laisse quand même le fichier et le code VBA au lieu de les supprimer, car c'est quand même un bon exemple pour ceux qui voudraient faire une inversion de 2 colonnes ; pour le véritable travail à effectuer, je propose un nouveau fichier dans mon post #23.

VB:

Sub Essai()
  If ActiveSheet.Name <> "BALANCE ANALYTIQUE" Then Exit Sub
  Dim T1, T2, nlm&, n1&, n2&, n3&, i&: nlm = Rows.Count
  n1 = Cells(nlm, 2).End(3).Row: n2 = Cells(nlm, 4).End(3).Row
  If Cells(n2, 4) = "-" Then n2 = Cells(n2, 4).End(3).Row
  n3 = WorksheetFunction.Max(n1, n2): If n3 = 2 Then Exit Sub
  n3 = n3 - 2: T1 = [B3].Resize(n3): T2 = [D3].Resize(n3)
  For i = 1 To n3
    If T1(i, 1) > 0 Then
      T2(i, 1) = T1(i, 1): T1(i, 1) = 0
    ElseIf T2(i, 1) > 0 Then
      T1(i, 1) = T2(i, 1): T2(i, 1) = 0
    End If
  Next i
  Application.ScreenUpdating = 0: [B3].Resize(n3) = T1
  [D3].Resize(n3) = T2
End Sub

soan

Phil69970 · 12 Mai 2021

Bonjour @soan

J'ai surtout voulu dire qu'il y a un pb sur SON fichier original car sur le fichier qu'il nous a fournit il n'a pas de pb.

oles à dit:
Mais comme dit, sur la maquette, cela fonctionne bien.

J'ai fait des test sur le fichier qu'il nous as fournit et c'est moins de 10 s pour 100 000 lignes et moins de 0.5 secondes pour 6 000 lignes alors que son fichier de travail c'est 15 mn !

Donc j'en ai conclu qu'il y a un pb sur son fichier.

Hypothèse pour @oles :
1)Ton fichier est rempli de plusieurs dizaines voir centaines de MFC
2)Il y a plein de liaison avec x fichiers et lors de la mise à jour une macro fait des navettes entre chaque ligne et chaque fichier
3)Une autre piste c'est de désactiver le calcul automatique en début de macro avec :
==> Application.Calculation = xlCalculationManual
Et le réactivé en fin de macro (c'est indispensable)
==> Application.Calculation = xlCalculationAutomatic
4)Tu l'anonymises et tu le postes et on regarde.

@Phil69970

oles · 12 Mai 2021

soan à dit:
Bonjour Phil, oles,

tu as écrit : « Manifestement il y a un pb sur le fichier » ; alors peut-être que ma solution avec la méthode des tableaux marchera mieux pour le fichier réel du demandeur oles ?

@oles : ton fichier en retour ; fais Ctrl e ➯ travail effectué ! pour info, la méthode des tableaux fait que c'est vraiment très rapide, même sur plusieurs milliers de lignes.

VB:

Sub Essai() If ActiveSheet.Name <> "BALANCE ANALYTIQUE" Then Exit Sub Dim T1, T2, nlm&, n1&, n2&, n3&, i&: nlm = Rows.Count n1 = Cells(nlm, 2).End(3).Row: n2 = Cells(nlm, 4).End(3).Row If Cells(n2, 4) = "-" Then n2 = Cells(n2, 4).End(3).Row n3 = WorksheetFunction.Max(n1, n2): If n3 = 2 Then Exit Sub n3 = n3 - 2: T1 = [B3].Resize(n3): T2 = [D3].Resize(n3) For i = 1 To n3 If T1(i, 1) > 0 Then T2(i, 1) = T1(i, 1): T1(i, 1) = 0 ElseIf T2(i, 1) > 0 Then T1(i, 1) = T2(i, 1): T2(i, 1) = 0 End If Next i Application.ScreenUpdating = 0: [B3].Resize(n3) = T1 [D3].Resize(n3) = T2 End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

Bonjour Soan,

J'ai testé d'abord sur la maquette que tu m'as envoyé.
La macro fonctionne, mais elle n'est pas abouti.
Il ne stocke pas les comptes en rouge sur le fichier (colonne B).

J'ai déjà entendu parlé des tableaux et de leur efficacité (en terme de vitesse d'exécution), mais je suis loin de pouvoir créé une macro avec des tableaux (pour le moment je suis pas assez expérimenté).

Olivier

soan · 12 Mai 2021

@Olivier

j'comprends pas : sur le fichier que j'ai, il n'y a pas de comptes en rouge ; de toute façon, ma macro ne s'occupe pas de couleurs ; elle fait seulement l'inversion des comptes de la colonne B en colonne D, et inversement ; c'était pas ça, le travail à faire ? j'ai peut-être mal compris ta demande ?

par contre, si j'me suis pas trompé sur ta demande, c'est ok sur mon fichier ; faudrait qu'tu m'envoies ton fichier (sans données confidentielles).

soan

XL 2016 Copier des valeurs et les coller dans une autre colonne

oles

XLDnaute Nouveau

Pièces jointes

Etoto

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

oles

XLDnaute Nouveau

Etoto

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

oles

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

oles

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

Pièces jointes

Phil69970

XLDnaute Barbatruc

oles

XLDnaute Nouveau

soan

XLDnaute Barbatruc

Discussions similaires