XL 2013 Optimisation forumle ou macro

J

julien91080

XLDnaute Occasionnel
Bonjour à la communauté,


Encore une fois, je me permets de faire appel à vos services suites à 2 semaines de travail intensif autour de mon problème.

Comme vous allez le voir, j’ai un gros fichier à traiter (sous Excel 2013) avec des formules à droite à gauche.

Une première formule (colonne W) teste si une personne à un code (colonne 7) renseigné dans l’onglet « OK ». Si la cellule est vide ou ne contenant pas la bonne valeur (par rapport à l’onglet « OK ») alors « non », si le code est présent, la formule test la colonne E.



L’autre grosse formule, procède à plusieurs tests :

Colonne F si même matricule, Colonne T si « NON », Colonne O si au moins une fois supérieur au 01/01/2014 et si colonne W au moins une fois « oui » => « Ok depuis 2014 »

Sinon

Colonne F si même matricule, Colonne T si « NON », Colonne O si au moins une fois supérieur au 01/01/2014 et si colonne W au moins une fois « Pas suffisant » => « Uniquement »

Sinon

Colonne F si même matricule, Colonne T si « NON », Colonne O si au moins une fois supérieur au 01/01/2014 et si colonne W au différent de « oui » => « En risque »

Sinon

« NON »


Mon soucis est que j’ai réussi à faire fonctionner (calculer) le tout une fois et puis plus rien.

La formule doit être trop lourde.

Existe-t-il une manière plus simple (par macro) à faire ou un moyen d’accélérer le calcule ?


Merci par avance pour votre aide.


Cordialement


Julien
 
Trier par date Trier par votes
Paf

Paf

XLDnaute Barbatruc
Re ,

pour la partie "Pas depuis son arrivée", remplacer:
Code: 
'******** préparation  et copie du Tableau final colonne W et X
ReDim TabFin(1 To UBound(Tablo), 1 To 2)
For i = LBound(Tablo) To UBound(Tablo)
    TabFin(i, 1) = Tablo(i, 18)
    TabFin(i, 2) = Dico1(CStr(Tablo(i, 1)))
Next
par:
Code: 
'******** préparation  et copie du Tableau final colonne W et X
ReDim TabFin(1 To UBound(Tablo), 1 To 2)
For i = LBound(Tablo) To UBound(Tablo)
    TabFin(i, 1) = Tablo(i, 18)
    TabFin(i, 2) = Dico1(CStr(Tablo(i, 1)))
    If Dico1(CStr(Tablo(i, 1))) = "NON" Then
        If Tablo(i, 9) = "" And Tablo(i, 15) = "NON" Then TabFin(i, 2) = "Pas depuis son arrivée"
    End If
Next

Attention, avant de lancer la macro, aucun filtre ne doit être actif !!!

Up : Un petit retour sur le temps de traitement ?????

A+
 
Vote positif 0 Vote négatif
J

julien91080

XLDnaute Occasionnel
Paf,

Après test, c'est super rapide sur 15 000 lignes. Je vais tester sur 250 000 lignes.


En terme de résultat du "Pas depuis son arrivé", pour le matricule 2015954, il a déjà passé une matière (cellule M3997), donc le résultat devrait être "En risque" vu que toutes les matières passées sont en "non" dans la colonne W.

J'ai essayé de modifier le code :

If Dico1(CStr(Tablo(i, 1))) = "NON" Then
If Tablo(i, 9) = "" And Tablo(i, 15) = "NON" Then TabFin(i, 2) = "Pas depuis son arrivée"
End If



Par:

If Dico1(CStr(Tablo(i, 1))) = "NON" Then
If Tablo(i, 8) = "" And Tablo(i, 15) = "NON" Then TabFin(i, 2) = "Pas depuis son arrivée"
End If


Mais cela ne donne pas un résultat satisfaisant puisqu'un collaborateur à du "En risque" et du " Pas depuis son arrivé" en même temps alors qu'il faudrait l'un ou l'autre.
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re,

cette fois ..... ???

J'ai pris en compte colonne M au lieu de N dans la détermination des " Pas depuis son arrivé" et rajouter un compteur pour les évaluer.

VB: 
Sub Julien_V3()
Dim WS1 As Worksheet, WS2 As Worksheet, Dico1, Dico2, TabTmp(1 To 2)
Dim Code As String, i As Long, Clé
Dim TabVerif, Clair As String
Set WS1 = Worksheets("Histo")
Set WS2 = Worksheets("OK")
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")

'**************  colonne W
'**creation dico des codes
Tablo = WS2.Range("A5:E" & WS2.Range("A" & Rows.Count).End(xlUp).Row)
For i = LBound(Tablo) To UBound(Tablo)
    TabTmp(1) = Tablo(i, 4)
    TabTmp(2) = Tablo(i, 5)
    Dico2(CStr(Tablo(i, 1))) = TabTmp
Next

Tablo = WS1.Range("F3:W" & WS1.Range("F" & Rows.Count).End(xlUp).Row)

'**mise à jour de la colonne W  dans le tablo histo
For i = LBound(Tablo) To UBound(Tablo)
    Code = CStr(Tablo(i, 8))
    If Not Dico2.Exists(Code) Then
        Tablo(i, 18) = "non"
        'WS1.Cells(i + 2, 23) = "non"
    ElseIf Dico2(Code)(2) = "x" Then
        Tablo(i, 18) = "Pas suffisant"
        'WS1.Cells(i + 2, 23) = "Pas suffisant"
    Else
        Tablo(i, 18) = Dico2(Code)(1)
        'WS1.Cells(i + 2, 23) = Dico1(Code)(1)
    End If
Next

'**************  colonne X

'* creation dico nombre de  oui,pas suffisant, <> oui et rajout compteur Pas depuis...
For i = LBound(Tablo) To UBound(Tablo)
    Matric = CStr(Tablo(i, 1))
    If Not Dico1.Exists(Matric) Then Dico1(Matric) = Array(0, 0, 0, 0)
    TabVerif = Dico1.Item(Matric)
    If Tablo(i, 15) = "NON" Then
        If Tablo(i, 8) = "" Then TabVerif(3) = TabVerif(3) + 1
        If Tablo(i, 10) >= CDate("01/01/2014") Then
            If Tablo(i, 18) = "oui" Then
                TabVerif(0) = TabVerif(0) + 1
            ElseIf Tablo(i, 18) = "Pas suffisant" Then
                TabVerif(1) = TabVerif(1) + 1
            ElseIf Tablo(i, 18) <> "oui" Then
                TabVerif(2) = TabVerif(2) + 1
            End If
        End If
        Dico1(Matric) = TabVerif
    End If
Next
' temporaire affichage des valeurs en colonne Z
'For i = LBound(Tablo) To UBound(Tablo)
     'Matric = CStr(Tablo(i, 1))
    'Cells(i + 2, 26) = Dico1(Matric)(0) & " " & Dico1(Matric)(1) & " " & Dico1(Matric)(2) & " " & Dico1(Matric)(3)
'Next
' traduction des nombres en clair
For Each Clé In Dico1
    If Dico1(Clé)(0) > 0 Then
        Clair = "Ok depuis le 01/01/2014"
    ElseIf Dico1(Clé)(1) > 0 Then
        Clair = "Uniquement"
    ElseIf Dico1(Clé)(2) > 0 Then
        Clair = "En risque"
    ElseIf Dico1(Clé)(3) > 0 Then
        Clair = "Pas depuis son arrivée"
    Else
        Clair = "NON"
    End If
    Dico1(Clé) = Clair
Next

'******** préparation  et copie du Tableau final colonne W et X
ReDim TabFin(1 To UBound(Tablo), 1 To 2)
For i = LBound(Tablo) To UBound(Tablo)
    TabFin(i, 1) = Tablo(i, 18)
    TabFin(i, 2) = Dico1(CStr(Tablo(i, 1)))
Next

WS1.Range("W3").Resize(UBound(TabFin, 1), 2) = TabFin
End Sub

Bon test
A+
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
Microsoft 365 besoin d'aide sur une formule excel
Réponses
2
Affichages
139
sylvanu
sylvanu
W
  • Question
Microsoft 365 Formule combinant multiples critères et OU
Réponses
4
Affichages
206
Wiil85
W
M
  • Question
XL 2021 Formule SI avec des arrondis ou mise en forme ?
Réponses
3
Affichages
148
Marie1608
M
S
  • Résolu(e)
XL 2016 aide pour une formule de comptage ?
Réponses
4
Affichages
128
shitoryu
S
M
  • Question
Microsoft 365 Déplacer une liste d’une rangée dans une colonne
Réponses
8
Affichages
193
Laurent78
L
A
  • Résolu(e)
Microsoft 365 Formule pour checker deux possibilités
Réponses
2
Affichages
163
Atlas85200
A
3
  • Question
XL 2013 copier et coller un tableau croisé dynamique
Réponses
3
Affichages
155
306255
3
B
  • Question
XL 2013 Transposition de filtres multiples sur plusieurs feuilles
Réponses
11
Affichages
279
BIROULIG
B
G
  • Question
XL 2013 Formule SOMMEPROD
Réponses
12
Affichages
203
TooFatBoy
TooFatBoy
A
  • Résolu(e)
Microsoft 365 Formule avec 2 conditions
Réponses
8
Affichages
285
AD95
A

Membres actuellement en ligne

21 membres et 237 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 316
Messages
2 087 177
Membres
103 491
dernier inscrit
bilg1