XL 2016 Traitement de données sur tableur

[OGPAC91]

Bonjour,

A partir du fichier "LISTE" ci-joint, je cherche à savoir :

- quel fournisseur est le moins cher en prix d'achat par article ?

- les 3 fournisseurs qui proposent le plus grand nombre de référence COMPATIBILITE=A

- quelle est la baisse de prix d'achat moyenne (en pourcentage) atteignable par article en cas d'utilisation de REFERENCE FOURNISSEUR avec COMPATIBILITE=A par rapport à ceux disponible en COMPATIBILITE=O en comparant le prix d'achat minimum ?

Merci d'avance pour votre aide.

Bill

 

[job75]

Bonsoir OGPAC91, bienvenue sur XLD,

Je ne comprends pas la 1ère et la 3ème question, soyez plus clair.

Pour la 2ème question voyez le fichier .xlsm joint et le tableau des résultats en colonnes G H I.

La colonne H utilise cette fonction VBA :

Function NbRéférences(P As Range, fournisseur$, critere$)
Dim tablo, d As Object, i&
tablo = P 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    If tablo(i, 4) = fournisseur And tablo(i, 5) = critere Then d(tablo(i, 2)) = ""
Next
NbRéférences = d.Count
End Function

Le code doit être placé impérativement dans un module standard.

Edit : j'ai corrigé le fichier car je n'avais pas été jusqu'en bas de la liste.

A+

 

[OGPAC91]

Bonsoir job75 et merci pour votre message

Je tente de reformuler ci-dessous les points 1 et 3 :

1° pour chaque ARTICLE, je cherche à savoir quel FOURNISSEUR propose le PRIX D'ACHAT le moins élevé

3° certaines REFRENCES FOURNISSEUR sont dispensés en COMPATIBILITE=A et en COMPATIBILITE=O
(exemple : 3650ER2005B).

Concernant ces cas précis, je souhaite calculer quelle baisse de prix d'achat moyenne (en pourcentage) est obtenable en ayant recours à l'achat de REFRENCES FOURNISSEUR en COMPATIBILITE=A plutôt qu'en COMPATIBILITE=O, lorsque cela est faisable.

Pour ce troisième point, mon axe de réflexion était de :

- identifier pour chaque REFRENCES FOURNISSEUR disponible en double COMPATIBILITE, le PRIX D'ACHAT le plus bas proposé en COMPATIBILITE=A puis le PRIX D'ACHAT le plus bas proposé en COMPATIBILITE=O

- calculer pour chaque REFRENCES FOURNISSEUR, l'écart de PRIX D'ACHAT entre le tarif proposé en COMPATIBILITE=A et le tarif proposé en COMPATIBILITE=O et faire une moyenne de toutes les opérations

Cela est-il plus clair ?

A vous lire,

Bill

 

[job75]

Bonjour OGPAC91, le forum,

Pour la 1ère question voyez ce fichier (2) et le code de la feuille "Prix minimum" :

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'ôte le filtre
UsedRange.Delete xlUp 'RAZ
Sheets("LISTE").[A:E].Copy [B1]
With [B1].CurrentRegion
    .Sort .Columns(1), xlAscending, .Columns(3), , xlAscending, Header:=xlYes 'tri dur ARTICLE et PRIX
    .Columns(0) = "=N(OFFSET(B1,-1,)<>B1)" '1 pour le changement de valeur
    .Cells(1, 0) = "FILTRE"
    .Columns(0).AutoFilter 1, 1 'filtre automatique pour afficher la 1ère ligne de chaque article
End With
End Sub

Edit : il manquait un point devant Columns(3)

A+

 

[OGPAC91]

Bonjour à toutes et tous,

Merci infiniment job75 pour votre réponse à mes deux premières questions

 

[job75]

Une coquille dans la macro précédente : il manquait un point devant Columns(3), j'ai corrigé.

 

[OGPAC91]

C'est noté job75
Pour la troisième question, mon raisonnement vous semble t-il correct ?
Si oui, auriez-vous une idée pour le traduire sur Excel ?
Merci d'avance

 

[job75]

Pour la 3ème question voyez ce fichier (3) et le code de la 3ème feuille :

Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, test As Boolean, deb&, j%, minA#, minO#, n&, k%
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
UsedRange.Delete xlUp 'RAZ
Sheets("LISTE").[A:E].Copy [A1]
With [A1].CurrentRegion
    .Sort .Columns(2), xlAscending, .Columns(5), , xlAscending, .Columns(3), xlDescending, Header:=xlYes 'tri sur REFERENCE, COMPATIBILITE et PZIX
    tablo = .Value 'matrice, plus raide
    ReDim resu(1 To UBound(tablo), 1 To 8)
    For i = 2 To UBound(tablo)
        test = tablo(i, 2) <> tablo(i - 1, 2) 'test sur REFERENCE
        If deb = 0 And test And tablo(i, 5) = "A" Then
            deb = i
        ElseIf deb And test Then
            If tablo(i - 1, 5) = "O" Then
                For j = deb To i - 1
                    If tablo(j, 5) = "A" Then minA = tablo(j, 3)
                    If tablo(j, 5) = "O" Then minO = tablo(j, 3)
                    n = n + 1
                    For k = 1 To 5: resu(n, k) = tablo(j, k): Next k
                Next j
                resu(n, 6) = minA
                resu(n, 7) = minO
                resu(n, 8) = minA / minO - 1 'variation
            End If
            deb = 0
        End If
    Next i
End With
'---restitution---
[G1:K1] = [A1:E1].Value
[L1] = "MIN PRIX A"
[M1] = "MIN PRIX O"
[N1] = "VAR A/O %"
[O1] = "MOYENNE" & vbLf & "VAR A/O %"
If n Then [G2].Resize(n, 8) = resu: [P1] = Application.Average([N:N])
[O1:P1].Interior.ColorIndex = 6 'jaune
End Sub

C'est compliqué, pas facile à comprendre ou à expliquer.

 

[OGPAC91]

Pour la 3ème question voyez ce fichier (3) et le code de la 3ème feuille :

Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, test As Boolean, deb&, j%, minA#, minO#, n&, k%
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
UsedRange.Delete xlUp 'RAZ
Sheets("LISTE").[A:E].Copy [A1]
With [A1].CurrentRegion
    .Sort .Columns(2), xlAscending, .Columns(5), , xlAscending, .Columns(3), xlDescending, Header:=xlYes 'tri sur REFERENCE, COMPATIBILITE et PZIX
    tablo = .Value 'matrice, plus raide
    ReDim resu(1 To UBound(tablo), 1 To 8)
    For i = 2 To UBound(tablo)
        test = tablo(i, 2) <> tablo(i - 1, 2) 'test sur REFERENCE
        If deb = 0 And test And tablo(i, 5) = "A" Then
            deb = i
        ElseIf deb And test Then
            If tablo(i - 1, 5) = "O" Then
                For j = deb To i - 1
                    If tablo(j, 5) = "A" Then minA = tablo(j, 3)
                    If tablo(j, 5) = "O" Then minO = tablo(j, 3)
                    n = n + 1
                    For k = 1 To 5: resu(n, k) = tablo(j, k): Next k
                Next j
                resu(n, 6) = minA
                resu(n, 7) = minO
                resu(n, 8) = minA / minO - 1 'variation
            End If
            deb = 0
        End If
    Next i
End With
'---restitution---
[G1:K1] = [A1:E1].Value
[L1] = "MIN PRIX A"
[M1] = "MIN PRIX O"
[N1] = "VAR A/O %"
[O1] = "MOYENNE" & vbLf & "VAR A/O %"
If n Then [G2].Resize(n, 8) = resu: [P1] = Application.Average([N:N])
[O1:P1].Interior.ColorIndex = 6 'jaune
End Sub

C'est compliqué, pas facile à comprendre ou à expliquer.

Vous forcez le respect job75
Un grand MERCI pour votre aide et votre disponibilité
A bientôt