XL 2010 Simplification code VBA(Résolu)

[Kael_88]

Le forum,
Bonjour, prenant en compte votre savoir, je me suis fait se petit code qui fonctionne, d'où ma question :
y a t il moyen de le simplifier avec un traitement des donnée rapide ?

PS: les feuilles sont d'environ 50000 lignes et 22 colonnes

Sub Import_A_D_E_F()

    Dim t, Maa, Saa, Kaa, d1 As Object, d2 As Object, i&, x$, y$, z$
    Dim WsMaa As Worksheet, WsSaa As Worksheet, WsKaa As Worksheet, WsMSK As Worksheet, WsSyE As Worksheet
    Dim rng As Range, derl As Long

    Set rng = Range("B2", Range("B50000").End(xlUp))    '.Select
    derl = rng.Rows.Count + 1

    Set WsMaa = Sheets("Data Maa") 'Feuil source Maa
    Set WsSaa = Sheets("Data Saa") 'Feuil source Saa
    Set WsKaa = Sheets("Data Kaa") 'Feuil source Kaa
    Set WsMSK = Sheets("Synthèse Maa & Saa & Kaa") 'Feuil destination
    Set WsSyE = Sheets("Synthèse Erreur") 'Feuil destination
    
    
    Maa = WsMaa.[A1].CurrentRegion.Resize(, 22)
    Saa = WsSaa.[A1].CurrentRegion.Resize(, 15)
    Kaa = WsKaa.[A1].CurrentRegion.Resize(, 15)
    SyE = WsSyE.[A1].CurrentRegion.Resize(, 15)

Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
Set d4 = CreateObject("Scripting.Dictionary")
Set d5 = CreateObject("Scripting.Dictionary")
Set d6 = CreateObject("Scripting.Dictionary")

    WsMSK.Range("D2:Z" & derl).ClearContents 'Suppression valeur du tableau
    WsMSK.Range("A2:A" & derl).ClearContents 'Suppression valeur du tableau


For i = 2 To UBound(SyE)
    y = SyE(i, 2)
    x = SyE(i, 7)
    z = SyE(i, 8)
    If x <> "" Then
        If d6.exists(y) Then
            d6(y) = d6(y) & Chr(10) & x
        Else
            d6(y) = x
        End If
    End If
    If z <> "" Then
        If d5.exists(y) Then
            d5(y) = d5(y) & Chr(10) & z
        Else
            d5(y) = z
        End If
    End If
Next

For i = 2 To UBound(Kaa)
    y = Kaa(i, 8)
    x = Kaa(i, 10)
    If x <> "" And x <> "0" Then
        If d4.exists(y) Then
            d4(y) = d4(y) & Chr(10) & x
        Else
            d4(y) = x
        End If
    End If
Next

For i = 2 To UBound(Saa)
    y = Saa(i, 1)
    x = Saa(i, 4)
    If x <> "" And x <> "0" Then
        If d3.exists(y) Then
            d3(y) = d3(y) & Chr(10) & x
        Else
            d3(y) = x
        End If
    End If
Next

For i = 2 To UBound(Maa)
    x = Maa(i, 5)
    y = Maa(i, 6)
    z = Maa(i, 14)
        If x <> "" Then
            If d1.exists(y) Then
                d1(y) = d1(y) & Chr(10) & x
            Else
                d1(y) = x
            End If
        End If
        If z <> "" Then
            If d2.exists(y) Then
                d2(y) = d2(y) & Chr(10) & z
            Else
                d2(y) = z
            End If
        End If
Next


    With WsMSK.[A1].CurrentRegion.Resize(, 9)
        t = .Value

        For i = 2 To UBound(t)
                t(i, 1) = d1(t(i, 2))
                t(i, 4) = d2(t(i, 2))
                t(i, 5) = d3(t(i, 2))
                t(i, 6) = d4(t(i, 2))
                t(i, 7) = d6(t(i, 2))
                t(i, 8) = d5(t(i, 2))
        Next

        If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
            .Columns(1) = Application.Index(t, , 1)
            .Columns(4) = Application.Index(t, , 4)
            .Columns(5) = Application.Index(t, , 5)
            .Columns(6) = Application.Index(t, , 6)
            .Columns(7) = Application.Index(t, , 7)
            .Columns(8) = Application.Index(t, , 8)
            .Columns(9) = Application.Index(t, , 9)

    End With

For i = 2 To derl

    If Cells(i, 4) <> "" Then
        texte = "=" & Cells(i, 4)
        Cells(i, 11) = Replace(texte, Chr(10), "+")
    Else
        Cells(i, 11) = ""
    End If
    If Cells(i, 5) <> "" Then
        texte = "=" & Cells(i, 5)
        Cells(i, 12) = Replace(texte, Chr(10), "+")
    Else
        Cells(i, 12) = ""
    End If
    If Cells(i, 6) <> "" Then
        texte = "=" & Cells(i, 6)
        Cells(i, 13) = Replace(texte, Chr(10), "+")
    Else
        Cells(i, 13) = ""
    End If

    If Cells(i, 11) <> Cells(i, 12) Then  'Or Cells(i, 11) <> Cells(i, 13) Then
        Cells(i, 9) = "Ecart"
    Else
    Cells(i, 9) = ""
    End If
Next i

        
    'Columns("A:z").AutoFit
    Range("A1:M1").Interior.ColorIndex = "6"
    Range("A:A").ColumnWidth = 12
    Range("B:B").ColumnWidth = 15
    Range("C:C").ColumnWidth = 40
    Range("D:G").ColumnWidth = 12
    Range("H:H").ColumnWidth = 80
    Range("I:M").ColumnWidth = 12



    Range("A1") = "Location"
    Range("B1") = "Materiel"
    Range("C1") = "Description"
    Range("D1").FormulaR1C1 = "=""Qté Maa :""&COUNTA(R[1]C:R[9999]C)"
    Range("E1").FormulaR1C1 = "=""Qté Saa : ""&COUNTA(R[1]C:R[9999]C)"
    Range("F1").FormulaR1C1 = "=""Qté Kaa : ""&COUNTA(R[1]C:R[9999]C)"
    Range("G1") = "Qté Réel"
    Range("H1") = "Commentaire"
    Range("I1") = "Différence"
    Range("J1") = " "
    Range("K1") = "Total" & Chr(10) & "Maa"
    Range("L1") = "Total" & Chr(10) & "Saa"
    Range("M1") = "Total" & Chr(10) & "Kaa"

    With Range("A1:Z" & derl)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        '.Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    With Range("A2:C" & derl)
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With


    Range("A2").Select

End Sub

En attente de vos conseilles.

Cordialement

 

[Kael_88]

Le forum, Staple1600,

Merci, désolé, je ne savais pas que l'on pouvait faire ça.
grâce à toi, je saurai que c'est possible pour la prochaine fois.

Merci pour le plaisir des Yeux.

Cordialement

 

[Kael_88]

Le forum,
Personne pour la simplification ???

Cordialement

 

[Staple1600]

Bonsoir le fil, le forum

@Kael_88
Un message avec du code VBA formaté grâce aux balises BBCODE, c'est bien
Une discussion avec dans son premier message un fichier Excel joint par le demandeur, c'est mieux 😉
Cela permet d'avoir une base sur laquelle tester les essais de simplifications.
Mais cela une membre inscrit depuis le 25 mars 2013 (as you are)
Cochez la bonne case
[ ] devrait le savoir
[ ] le sait mais l'ignore
[ ] le sait et l'ignore car n' a pas le temps de créer un fichier exemple.

PS: message rédigé en mode humoristique (donc inutile de s’énerver)

 

[Kael_88]

Le forum, Staple1600,

Permet moi Staple1600 de te signaler que je vois pas la relation de tes messages avec le sujet,

De un, ma date d'inscription : je ne vois pas le rapport mais je ne viens que lorsque je bloque sur un problème, que j'essaye par moi-même de résoudre avant.
De deux, que si tu avais regardé mes précédant posts, tu aurais vu qu'a chaque fois il y avais un fichier.
De trois, si tu n'est pas capable de te faire un fichier et copier le code, tu dois pas être très .....
De quatre, ceci n'est qu'une simple extraction d'un code beaucoup plus grand.
De cinq, la question était(je te le rappel, au cas ou tu comprennes pas) " prenant en compte votre savoir, je me suis fait se petit code qui fonctionne, d'où ma question : y a t il moyen de le simplifier avec un traitement des donnée rapide ?"
De six, tes réflexions gâche les posts sur lesquels tu fais du zèle.
De sept, si ton but est de fanfaronner, il existe des sites à cette effet, tu devrais t'y plaire, je t'encourage pleinement à t'y rendre.
De huit, je ne vois rien de concret dans ton intervention.
De neuf, s'il y a des choses à dire, je pense qu'il y a des Administrateurs pour ça.
De dix, quand à ton sondage en fin de post, tu devrais plutôt éviter, je risquerai de le prendre pour une agression écrite.

merci de ta compréhension.

PS: Au vu de ton dernier post, tu dois détester une grande partie de ta vie. C’est pourquoi, tu tentes d’intoxiquer la vie des autres, dans la mesure de tes possibilités.

Cordialement

 

[Staple1600]

Bonjour le fil, le forum

@Kael_88
J'aurai du écrire cela en plus grand dans mon précédent message

Bonsoir le fil, le forum
@Kael_88
PS: message rédigé en mode humoristique (donc inutile de s’énerver)

•Pourquoi devrions-nous perdre notre temps à recréer un fichier qui existe sur ton disque dur?
•Pourquoi si tu joins un fichier dans chacune de tes discussions, tu ne l'as pas fait dans celle-ci?

Pour le reste, c'est ton ressenti qui lui aussi n'a pas grand chose à voir avec ta question.

PS: Donc fichier ou pas fichier?

[aparté]
A la lecture de ceci

Pour tous
1 – Les forums doivent rester conviviaux.
Donc, les échanges doivent être courtois, respectueux et garder la bonne humeur.
Les propos agressifs ne sont donc pas tolérés.

Et à la relecture du message#5 et message#6, lequel est le plus agressif, hein ?
[/aparté]

[addenda]
Ayant reconnu la patte de job75 dans une partie de ton code, je suis arrivé sur un tes fils
https://www.excel-downloads.com/thr...leurs-dun-tableau-à-un-autre-résolu.20023885/
Est-ce que par hasard le fichier que tu as posté là-bas pourrait servir de support ici ?
[/addenda]

 

[cathodique]

Bonjour JM😉, Kael_88🙂,

Je trouve déplorable que sur un forum d'entraide ça tourne au "vinaigre" comme cette discussion.

@Staple1600 : ton humour a tatillonné les nerfs de notre ami. Merci d'être indulgent à son égare. Il galère sans doute pour trouver une solution.

@Kael_88 : Il faudrait respecter la charte du forum. Je reconnais que quelques fois, on met beaucoup de temps pour monter un fichier illustrant notre problème. Ce n'est qu'à ce prix qu'on avance.

Il me semble que tu as omis une chose très importante: les intervenants sont bénévoles. Donc les partages d’expériences et de connaissances sont à titre gracieux. N'en demande pas trop, on ne va pas quand même monter un fichier à ta place. Et même si ça serait le cas, Le fichier ne sera pas une fidèle reproduction du tien.

Si tu veux de l'aide prend-toi d'abord en charge.

Dans la joie et la bonne humeur, bon dimanche à toutes et à tous.😀😀😀

 

[Staple1600]

Bonjour cathodique

Bonjour JM😉, Kael_88🙂,
@Staple1600 : ton humour a tatillonné les nerfs de notre ami.
Merci d'être indulgent à son égare. Il galère sans doute pour trouver une solution.

Le forum,
Bonjour, prenant en compte votre savoir, je me suis fait se petit code qui fonctionne, d'où ma question :

NB: il ne galère pas, la macro fonctionne, le souhait est de simplifier la syntaxe
Pour ce qui me concerne, égard et indulgence étaient là dés le départ, non ?
avec l'humour en prime et en bonus un émoticone.

Bonsoir le fil, le forum
PS: message rédigé en mode humoristique (donc inutile de s’énerver)

Après on peut être sensible ou pas à mon humour 😉

 

[Kael_88]

Le Forum,

Ci joint le Fichier original, avec de fausse données.

voir si on peux simplifier les codes VBA, sachant que le tableau fait environ 50000 lignes et 22 colonnes.

merci de votre savoir.

cordialement

 

[job75]

Bonjour Kael_88, JM, cathodique, le forum,

Le problème n'est pas de simplifier le code mais de rester logique.

La dernière boucle traite les cellules une par une, ce qui est lent (6,7 secondes sur seulement 251 lignes).

Alors que toutes les autres boucles utilisent des tableaux VBA très rapides (0,15 seconde)...

Bonne journée.

 

[pierrejean]

Bonjour à tous

Un essai visant à améliorer le temps de traitement
1) Utilisation d'un tableau pour la dernière boucle selon préconisation de Gerard
2) Suppression de if d().exists
NB: Je n'ai pas pu contrôler le résultat
Le gain chez moi est de l'ordre de 30% du temps

 

[job75]

Bonjour Pierre, heureux de te croiser 🙂

Il suffit de regrouper les 2 dernières boucles en une seule :

With WsMSK.[A1].CurrentRegion.Resize(, 13)
    t = .Value
  
    For i = 2 To UBound(t)
        t(i, 1) = d1(t(i, 2))
        t(i, 4) = d2(t(i, 2))
        t(i, 5) = d3(t(i, 2))
        t(i, 6) = d4(t(i, 2))
        t(i, 7) = d6(t(i, 2))
        t(i, 8) = d5(t(i, 2))
        If t(i, 4) <> "" Then
            t(i, 11) = Replace("=" & t(i, 4), Chr(10), "+")
        Else
            t(i, 11) = ""
        End If
        If t(i, 5) <> "" Then
            t(i, 12) = Replace("=" & t(i, 5), Chr(10), "+")
        Else
            t(i, 12) = ""
        End If
        If t(i, 6) <> "" Then
            t(i, 13) = Replace("=" & t(i, 6), Chr(10), "+")
        Else
            t(i, 13) = ""
        End If
        If t(i, 11) <> t(i, 12) Then  'Or t(i, 11) <> t(i, 13) Then
            t(i, 9) = "Ecart"
        Else
            t(i, 9) = ""
        End If
    Next
      
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .Value = t 'restitution
End With

Seule la restitution du tableau t prend du temps, et ceci parce que la dernière cellule (touche F5) est [Edit] Z50006...

Ce qui a un effet même avec un tableau de 251 lignes.

A+

 

[Kael_88]

Le forum, @Staple1600, @cathodique,@Job75,@pierrejean,

En premier, je m'excuse auprès du forum & de @Staple1600 pour les commentaires supérieurs, il est vrai que nous n'avons pas le même humour.

En second, je vous remercie tous pour vos sages conseilles & votre implication sur tout types de sujets.

En tertio, Merci à vous tous pour votre aide précieuse dans vos modifications & vos conseils de mon code, qui me permet aussi d'apprendre.

Encore Merci à vous et je vais sans plus attendre reprendre votre savoir afin de faire évoluer mon fichier.

Je pense que je peux mettre résolu.

Cordialement