Comment alléger ou changer ma formule [RechercheX + SI + Trier par]

Bonjour à tous,

Après avoir retourné le problème dans tous les sens je ne trouve pas la réponse, je m'explique, j'ai besoin d'obtenir grâce à une base de données en constante évolution, le dernier prix d'achat, ainsi que le dernier prix de vente.

Les tableaux sont conséquents, pour respecter la confidentialité des données, j'ai remplacé la data par des nombres en aléa, néanmoins les formules sont visibles et des tests sont possibles.

Pour réaliser cela, j'ai mis en place cette formule dans l'onglet listing :

=RECHERCHEX(A3;
TRIERPAR( SI(ACHAT!B:B;ACHAT!C:C);ACHAT!A:A; -1);
TRIERPAR( ACHAT!B:B;ACHAT!A:A;-1);)

La formule fonctionne parfaitement, malheureusement je ne peux la dupliquer sur la totalité des 99400 lignes de mon fichier de base, car cela a pour conséquence de le rendre totalement inutilisable.

Je suis désespéré, car c'est ce qui conditionne ma suite de donnée complète par la suite, avez-vous une idée de comment simplifier la formule, la remplacer, ou même un autre système auquel je n'ai pas pensé.

Pourriez-vous m'éclairer svp ?

Merci d'avance

Bonjour Rasman63 et

Tu as plusieurs possibilités :

1) Soit, utiliser des formules plus simple mais qui fonctionnent
Pour le dernier prix d'achat à recopier vers le bas

=SOMME.SI.ENS(ACHAT!B:B;ACHAT!C:C;A3;ACHAT!A:A;MAX.SI.ENS(ACHAT!A:A;ACHAT!C:C;A3))

Pour le dernier prix de vente à recopier vers le bas

=SOMME.SI.ENS(VENTE!C:C;VENTE!D:D;A3;VENTE!A:A;MAX.SI.ENS(VENTE!A:A;VENTE!D:D;A3))

2) Soit, utiliser du VBA qui fera le calcul après avoir cliqué sur un bouton(par exemple)
Ca reste long sur presque 7000 lignes, mais si ce n'est pas fait trop souvent

Sub MàJDernierPrix()
  Dim LTab As Variant
  Dim dLig As Long, Ind As Long, NbVal As Long
  Dim DerPxA As Double, DerPxV As Double
  Dim sForm As String

  With Sheets("LISTING")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    LTab = .Range("B3:C" & dLig).Value
    NbVal = UBound(LTab)
    For Ind = 1 To NbVal
      Application.StatusBar = "Veuillez patienter, MàJ de la référence " & Ind & "/" & NbVal
      sForm = "=SUMIFS(ACHAT!B:B,ACHAT!C:C,A" & 2 + Ind & ",ACHAT!A:A,MAXIFS(ACHAT!A:A,ACHAT!C:C,A" & 2 + Ind & "))"
      '.Range("E" & 2 + Ind).Formula = sForm
      DerPxA = Application.Evaluate(sForm)
      LTab(Ind, 1) = DerPxA
      sForm = "=SUMIFS(VENTE!C:C,VENTE!D:D,A" & 2 + Ind & ",VENTE!A:A,MAXIFS(VENTE!A:A,VENTE!D:D,A" & 2 + Ind & "))"
      '.Range("F" & 2 + Ind).Formula = sForm
      DerPxV = Application.Evaluate(sForm)
      LTab(Ind, 2) = DerPxV
    Next Ind
    ' Renvoyer les récultats
    .Range("B3:C" & dLig).Value = LTab
  End With
End Sub

3) En utilisant peut-être PQ, mais là je ne suis pas assez calé

A+

Bonjour à toutes et tous,
Une proposition Power Query.
J'ai supprimé des données pour un souci de taille de fichier.
Cdlt.

bonjour,

solution avec formules (plus efficace que ce somme.si) , peut-être il y a aussi une solution avec un TCD

=SIERREUR(INDEX(ACHAT[Prix d''achat];EQUIV(AGREGAT(14;6;ACHAT[Créé le]/(ACHAT[Référence]=A3);1) & "|" & LISTING!A3;ACHAT[Créé le] & "|" & ACHAT[Référence];0));"--")

EDIT : avec un TCD, ce n'est pas efficace

re,

solution VBA (fichier avec des données supprimés pour la taille)

Sub Dictionaire()
     Dim vide(4)
     t = Timer
     Set dict = CreateObject("scripting.dictionary")
     a = Range("achat").Value2
     v = Range("Vente").Value2

     For i = 1 To UBound(a)
          If Not dict.exists(a(i, 3)) Then vide(0) = a(i, 3): dict(a(i, 3)) = vide
          it = dict(a(i, 3))
          If a(i, 1) > it(1) Then
               it(1) = a(i, 1)
               it(2) = a(i, 2)
               dict(a(i, 3)) = it
          End If
     Next

     For i = 1 To UBound(v)
          If Not dict.exists(v(i, 4)) Then vide(0) = v(i, 4): dict(v(i, 4)) = vide
          it = dict(v(i, 4))
          If v(i, 1) > it(3) Then
               it(3) = v(i, 1)
               it(4) = v(i, 3)
               dict(v(i, 4)) = it
          End If
     Next

     With Sheets("listing").ListObjects("TBL_Dernier")
          If .ListRows.Count Then .DataBodyRange.Delete
          If dict.Count Then
               .ListRows.Add.Range.Range("A1").Resize(dict.Count, 5) = Application.Index(dict.items, 0, 0)
               .Range.Sort .Range.Range("A1"), Header:=xlYes
          End If
     End With

     MsgBox "prêt en " & Format(Timer - t, "0.000\s")
End Sub

Re,

Merci à tous de m'avoir aidé sur mon problème qui n'était apparemment pas si épineux que cela.

Il faut vraiment que je me forme sur PQ, car je n'ai pas les compétences nécessaires pour appliquer la méthode qui je pense et la plus efficiente. Dans tous les cas, merci d'avoir pris le temps de m'aider, vos réponses ont étaient claires et complémentaires.

Cordialement