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

[oles]

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]

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]

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]

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]

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

 

[Phil69970]

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]

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

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]

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

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]

Bonjour @oles

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]

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

 

[Phil69970]

@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]

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. ​

---

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]

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.

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]

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.​

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]

@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