Optimisation calcul position occurrence valeur

Bonjour,

J'ai un XLSX de 975473 lignes répertoriant les tarifs à date d'une BDD articles.

Pour chaque article, je cherche à identifier le tarif en application : c-à-d, dont la date d'effet est la plus récente.

Exemple

Après avoir trié les dates du plus ancien au plus récent, je cherche à établir le numéro position de chaque occurrence article.

Ainsi, je serai en mesure d'établir le tarif en application.

Je connais la formule Excel : NB.SI($B$2:$B2;$B2).

J'ai développé une macro qui fonctionne correctement :

Sub Macro()

Dim Wbk As Workbook
Dim Tar As Worksheet
Dim Rge As Range
Dim LRo, RowID As Long

        Set Wbk = Application.ThisWorkbook
        Set Tar = Wbk.Sheets("ATARPAP1")

        LRo = Tar.Cells(1, 1).End(xlDown).Row

        For Index = 2 To LRo

            Tar.Activate
            Set Rge = Tar.Range(Cells(Index, 3), Cells(Index, 3))

            With Rge.Select
                RowID = WorksheetFunction.CountIf(Range(Cells(2, 2), Cells(Index, 2)), Cells(Index, 2))
                Rge.Value = RowID
            End With

        Next

    MsgBox "Fin"

End Sub

Mais au vu du nombre de lignes, les calculs sont très longs.

Une idée pour optimiser les calculs ? Voire une autre solution pour répondre au besoin ?

Merci par avance,

ATB

Bonjour Towelie,

Pour ce que j'en ai compris, voici un essai.

1. cliquer sur le bouton vert pour initialiser 1 000 000 lignes de données source
2. puis cliquer sur le bouton bleu pour lancer le traitement (pour OK ou nok dans la colonne C)

Les codes sont dans le module associé à la feuille "Feuil1".

Sub OKnok()
Dim der As Long
   Application.ScreenUpdating = False
   With Sheets("Feuil1")
      If .FilterMode Then .ShowAllData
      der = .Cells(Rows.Count, "a").End(xlUp).Row
      Range("a1:b" & der).Sort key1:=Range("b1"), order1:=xlAscending, key2:=Range("a1"), order2:=xlDescending, _
                                 Header:=xlYes, MatchCase:=False
      Range("c2:c" & der).FormulaR1C1 = "=IF(RC[-1]<>R[-1]C[-1],""OK"",""nok"")"
      Range("c1:c" & der) = Range("c1:c" & der).Value
      With Range("a2:c" & der)
         .FormatConditions.Delete
         .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2<>$B1"
         With .FormatConditions(1).Borders(xlTop)
            .LineStyle = xlContinuous
            .Color = -65536
            .TintAndShade = 0
            .Weight = xlThin
         End With
      End With
   End With
End Sub

bonjour MaFraise, Towelie,

un TCD pouvait vous donner la réponse même sans trier.

Bonjour à tous !

Avez-vous étudié la piste Power Query (nativement intégré dans Excel à partir de 2016) ?

La base externalisée pourrait être lue et retraitée, afin de mettre à votre disposition les éléments souhaités (Référence, date, prix, etc...).

Hello,

Une proposition avec formule et une proposition avec PowerQuery,

Le tout dans le même fichier

@+

Bonjour,

C'est parfait, merci à tous pour vos réponses !

Towelie