Optimisation de formule

Bonjour à tous,

Voici mon problème:

au lieu de passer par une boucle et me prendre la tête, je suis tombé sur une formule "magique" permettant la réalisation de ma macro .. MAIS, beauuuuuuuuuuuuuuucoup trop lent. Je vous explique:

En colonne A j'ai des individus, en colonne I, des montants, il se peut qu'il y ait plusieurs informations pour un individus, il peut donc avoir plusieurs lignes lui correspondant.

Le travail à faire (une petite partie en tout cas) consiste à vérifier que la somme des montants pour un individu (s'il existe sur plusieurs ligne) soit égale à 100, ni plus, ni moins, sinon en colonne J j'inscris la mention "Anomalie montant".

Voici ma formule: =SI(SOMME.SI(A:A;A2;I:I)=100;"";"Anomalie Montant")

Sous macro elle devient: =IF(SUMIF(C[-9],RC[-9],C[-1])=100,"""",""Anomalie Calc"")

(que je faisais dérouler sous un autofill, mais maintenant sous un for jusqu'à la fin, mais sans changement)

Ce fichier comporte 40 000 lignes environ, c'est pourquoi je pense qu'au niveau du calcul, il galère pas mal.

Auriez vous une solution à mon problème permettant l'optimisation de mon code ? Merci d'avance

Bonjour

40 000 lignes avec une formule matricielle, déjà c'est pas mal.

Mais en plus, tu fais appel aux colonnes entières. Essaye déjà avec les plages réelles si c'est plus rapide (genre A2:A100 / I2:I100)

Amicalement

Nad

46494 très exactement, mais la lenteur du processus est aussi surement lié au pc que j'utilise... En le redémarant ça ferait peut être quelque chose mais ma journée est terminé, excel m'a rendu fou, je reprendrais ça lundi..

J'ai essayé manuellement de changer la plage comme tu me l'as indiqué, mais je n'ai pas pu remarqué de gros changement (j'ai arrêté Excel quand au bout de 5mn le calcul était toujours à 5% et que tout plantait).

Merci tout de même ^^

Bonjour,

Une proposition VBA et TCD (tableau croisé dynamique) et le choix d'une mise en forme.

Proposition à adapter. A te relire.

ALT F11 pour visualiser les procédures VBA.

Option Explicit
Option Private Module
Public Sub TCD_anomalies()
Dim ws As Worksheet, _
    rng As Range, _
    finalCol As Integer, _
    ptCache As PivotCache, _
    pt As PivotTable, _
    lastRow As Long, i As Long, _
    msg As String, title As String, style As Long, reponse As Integer

    FastRun (False)

    Set ws = Worksheets("Données")

    For Each pt In ws.PivotTables
        pt.TableRange2.Clear
    Next pt
    ws.Range("D1:F1").EntireColumn.Clear
    finalCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A1").CurrentRegion
    Set ptCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng.Address)
    Set pt = ptCache.CreatePivotTable(TableDestination:=ws.Cells(1, finalCol + 2), TableName:="TCD_1")
    pt.ManualUpdate = True

    pt.AddFields RowFields:="individu"

    With pt.PivotFields("montant")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "# ##0"
        .Name = "montant "
    End With

    pt.CalculatedFields.Add "commentaire", "=IF(montant >100,1,0)", True

    With pt.PivotFields("commentaire")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 2
        .NumberFormat = "[=1]""anomalie"";;"
        .Name = "commentaire "
    End With

    pt.RowAxisLayout RowLayout:=xlTabularRow
    pt.DataPivotField.Orientation = xlColumnField
    pt.ColumnGrand = False

    pt.ManualUpdate = False
    pt.ManualUpdate = True

    msg = "Voulez-vous supprimer le TCD et ne conserver que les valeurs?"
    style = vbYesNo
    title = "Mise en forme finale"
    reponse = MsgBox(msg, style, title)

    If reponse = vbYes Then
        pt.TableRange2.Offset(1, 0).Copy
        pt.TableRange1.Cells(1, 1).Offset(0, pt.TableRange1.Columns.Count + 2).PasteSpecial xlPasteValuesAndNumberFormats
        pt.TableRange2.Clear
        Columns("D:H").Delete
        lastRow = Range("D" & Rows.Count).End(xlUp).Row
        For i = lastRow To 2 Step -1
            If Cells(i, 6) = 0 Then
                Range("D" & i & ":" & "F" & i).Delete
            End If
        Next
        Columns("F:F").Delete
    End If

    [A1].Select

    FastRun (True)
    Set ws = Nothing
    Set ptCache = Nothing
    Set pt = Nothing
    Set rng = Nothing

End Sub

Bonjour Jean-Eric,

Merci de ta proposition, mais malheureusement, je ne peux étudier et travailler sur ton fichier, étant donnée que je travail sous Excel 2003 :/

Re,

To profil indique 2013

Une version 2003 à tester.

Ahh, j'ai mis à jour mon profil, merci ^^

J'ai repris le module faisant les opérations d'optimisation du tps d'execution, et ça a déjà divisé le temps par 2, je pense que je vais m'en contenter. Quant au TCD, je n'en utilise jamais et je préfère garder ça de côté plutôt que de me perdre là dedans ^^

Merci de ton aide, c'est résolu

Bonjour,

autre proposition avec dictionary à tester.

eric

Ah oui .. Là on ne joue plus dans la même cour !

Le problème là c'est que ... C'est trop rapide !

Je plaisante bien sur ... C'est parfait, je ne connaissais pas du tout cette méthode, avec ma formule matricielle ma macro prenait environ 500 secondes ( environ 8.5 minutes), là .. Moins d'1, c'est parfait !

Merci beaucoup !!