"Résolu" Résultat selon conditions

P

Pedro Andrade

XLDnaute Nouveau
Bonjour, après plusieurs jours de recherche et de tâtonnement je me tourne vers vous pour avoir votre aide, j’espère que je serais assez claire dans mes explications. Dans une base de données je rentre manuellement la somme des dépenses et des recettes pour l'année écoulée, j'aimerais avoir en colonne "G" avec une formule les résultats indiqués dans l'exemple. Pouvez-vous m'aider?
 

Pièces jointes

  • Résultat selon conditions.xlsx
    12 KB · Affichages: 28
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonjour le forum,

Cette macro évènementielle entre les formules en colonne G et effectue les tris comme je l'ai indiqué au post #11 :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim memcol, MS
With [A1].CurrentRegion
    If .Rows.Count = 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    '---numérotation provisoire en colonne A---
    memcol = .Columns(1) 'mémorise la colonne A
    .Cells(2, 1) = 1
    .Cells(2, 1).Resize(.Rows.Count - 1).DataSeries
    '---1er tri sur les colonnes B C D E---
    Set MS = Me.Sort
    MS.SortFields.Clear
    MS.SortFields.Add Key:=.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MS.SortFields.Add Key:=.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MS.SortFields.Add Key:=.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MS.SortFields.Add Key:=.Columns(5), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MS.SetRange .Cells
    MS.Header = xlYes
    MS.MatchCase = False
    MS.Orientation = xlTopToBottom
    MS.SortMethod = xlPinYin
    MS.Apply
    '---colonne G---
    With .Cells(2, 7).Resize(.Rows.Count - 1)
        .Formula = "=IF(B2&C2&D2<>B1&C1&D1,""*"",REPT(""E"",F2=F1)&REPT(IF(B2=""Dépenses"",""P"",""N""),F2<F1)&REPT(IF(B2=""Dépenses"",""N"",""P""),F2>F1))"
        .Value = .Value 'supprime les formules
    End With
    '---2ème tri sur la colonne A, ordre initial---
    .Sort .Columns(1), xlAscending, Header:=xlYes
    .Columns(1) = memcol
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub
Elle se déclenche automatiquement quand on modifie ou valide une cellule quelconque.

Elle fonctionne même si le tableau n'est pas un tableau Excel structuré.

Sur le fichier joint les couleurs liées aux valeurs E P N en colonne G apparaissent à partir de la ligne 42.

Bonne journée.
 

Pièces jointes

  • Résultat selon conditions (budget)(1).xlsm
    30.3 KB · Affichages: 17
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
job75 à dit:
On peut filtrer sans problème mais alors si on modifie ou valide une cellule les résultats en colonne G peuvent être erronés.
Cliquez pour agrandir...
Pour éviter tout souci, dans ce fichier (2) la macro annule le filtrage éventuel :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim memcol, MS
With [A1].CurrentRegion
    If .Rows.Count = 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    '---annule le filtrage éventuel---
    .AutoFilter
    .AutoFilter
    '---numérotation provisoire en colonne A---
    memcol = .Columns(1) 'mémorise la colonne A
    .Cells(2, 1) = 1
    .Cells(2, 1).Resize(.Rows.Count - 1).DataSeries
    '---1er tri sur les colonnes B C D E---
    Set MS = Me.Sort
    MS.SortFields.Clear
    MS.SortFields.Add Key:=.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MS.SortFields.Add Key:=.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MS.SortFields.Add Key:=.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MS.SortFields.Add Key:=.Columns(5), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MS.SetRange .Cells
    MS.Header = xlYes
    MS.MatchCase = False
    MS.Orientation = xlTopToBottom
    MS.SortMethod = xlPinYin
    MS.Apply
    '---colonne G---
    With .Cells(2, 7).Resize(.Rows.Count - 1)
        .Formula = "=IF(B2&C2&D2<>B1&C1&D1,""*"",REPT(""E"",F2=F1)&REPT(IF(B2=""Dépenses"",""P"",""N""),F2<F1)&REPT(IF(B2=""Dépenses"",""N"",""P""),F2>F1))"
        .Value = .Value 'supprime les formules
    End With
    '---2ème tri sur la colonne A, ordre initial---
    .Sort .Columns(1), xlAscending, Header:=xlYes
    .Columns(1) = memcol
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub
 

Pièces jointes

  • Résultat selon conditions (budget)(2).xlsm
    30.6 KB · Affichages: 6
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Pedro Andrade, James007, le forum,

Avec ce fichier (3) voici une solution qui va plaire à James007 puisqu'elle utilise une fonction VBA.

L'avantage c'est qu'on ne touche pas du tout au filtrage du tableau.

Mais c'est nettement plus compliqué et plus lent : sur 10 000 lignes les formules se recalculent en 3,5 secondes.

Pourtant le code dans Module1 utilise 2 Dictionary et la macro de tri Quick sort :
VB: 
Public d1 As Object, d2 As Object 'mémorise les variables

Function ENP$(r As Range)
Application.Volatile
Dim x$, a, b, annee#, i&
If d1 Is Nothing Then Dictionnaire
x = r(1) & r(2) & r(3) 'colonnes B C D
a = Split(d1(x))
b = Split(d2(x))
tri a, b, 0, UBound(a)
annee = Val(r(4))
For i = 0 To UBound(a)
    If Val(a(i)) = annee Then
        If i = 0 Then
            ENP = "*"
        ElseIf b(i) = b(i - 1) Then
            ENP = "E"
        Else
            ENP = IIf(LCase(r(1)) = "dépenses" And Val(b(i)) < Val(b(i - 1)) Or LCase(r(1)) <> "dépenses" And Val(b(i)) > Val(b(i - 1)), "P", "N")
        End If
        Exit For
    End If
Next
End Function

Sub Dictionnaire()
Dim tablo, i, x$
tablo = [A1].CurrentRegion.Resize(, 6)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
d2.CompareMode = vbTextCompare
For i = 2 To UBound(tablo)
    x = tablo(i, 2) & tablo(i, 3) & tablo(i, 4) 'colonnes B C D
    d1(x) = Trim(d1(x) & " " & Val(tablo(i, 5)))
    d2(x) = Trim(d2(x) & " " & Val(Replace(tablo(i, 6), ",", ".")))
Next
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub
La macro Dictionnaire est relancée par les 2 macros Workbook_Open et Worksheet_Change.

La formule en G2 utilise la fonction ENP avec comme argument la plage B2:E2 =ENP(BDD[@[Type]:[Année]])

A+
 

Pièces jointes

  • Résultat selon conditions (budget)(3).xlsm
    36 KB · Affichages: 14
Dernière édition:
Vote positif 0 Vote négatif
P

Pedro Andrade

XLDnaute Nouveau
job75 à dit:
Bonjour Pedro Andrade, James007, le forum,

Avec ce fichier (3) voici une solution qui va plaire à James007 puisqu'elle utilise une fonction VBA.

L'avantage c'est qu'on ne touche pas du tout au filtrage du tableau.

Mais c'est nettement plus compliqué et plus lent : sur 10 000 lignes les formules se recalculent en 3,5 secondes.

Pourtant le code dans Module1 utilise 2 Dictionary et la macro de tri Quick sort :
VB: 
Public d1 As Object, d2 As Object 'mémorise les variables

Function ENP$(r As Range)
Application.Volatile
Dim x$, a, b, annee#, i&
If d1 Is Nothing Then Dictionnaire
x = r(1) & r(2) & r(3) 'colonnes B C D
a = Split(d1(x))
b = Split(d2(x))
tri a, b, 0, UBound(a)
annee = Val(r(4))
For i = 0 To UBound(a)
    If Val(a(i)) = annee Then
        If i = 0 Then
            ENP = "*"
        ElseIf b(i) = b(i - 1) Then
            ENP = "E"
        Else
            ENP = IIf(LCase(r(1)) = "dépenses" And Val(b(i)) < Val(b(i - 1)) Or LCase(r(1)) <> "dépenses" And Val(b(i)) > Val(b(i - 1)), "P", "N")
        End If
        Exit For
    End If
Next
End Function

Sub Dictionnaire()
Dim tablo, i, x$
tablo = [A1].CurrentRegion.Resize(, 6)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
d2.CompareMode = vbTextCompare
For i = 2 To UBound(tablo)
    x = tablo(i, 2) & tablo(i, 3) & tablo(i, 4) 'colonnes B C D
    d1(x) = Trim(d1(x) & " " & Val(tablo(i, 5)))
    d2(x) = Trim(d2(x) & " " & Val(Replace(tablo(i, 6), ",", ".")))
Next
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub
La macro Dictionnaire est relancée par les 2 macros Workbook_Open et Worksheet_Change.

La formule en G2 utilise la fonction ENP avec comme argument la plage B2:E2 =ENP(BDD[@[Type]:[Année]])

A+
Cliquez pour agrandir...
Re-salut, quand j'ouvre ton dernier fichier j'ai ce message ?!?
 

Pièces jointes

  • 2019-12-24_13-33-23.png
    2019-12-24_13-33-23.png
    7 KB · Affichages: 7
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
Microsoft 365 formules ne pas afficher résultat et calcul
Réponses
0
Affichages
208
Chapichapo
C
F
  • Question
XL 2019 Faire une "cartographie" selon des périodes.
Réponses
12
Affichages
689
fanou06
F
S
  • Question
Autres Macro sous conditions
Réponses
3
Affichages
300
scorpileo
S
N
  • Résolu(e)
XL 2016 MFC qui s'efface selon remplissage cellule voisine
Réponses
10
Affichages
726
NIKITACAM
N
S
  • Résolu(e)
XL 2013 Nombre de dates sous conditions
Réponses
6
Affichages
969
Efgé
Efgé
A
  • Question
XL pour MAC outils tableau, création automatique de ligne à partir d'un autre tableau
Réponses
5
Affichages
770
axel211
A
O
  • Résolu(e)
XL 2013 VBA qui copie et colle dans un autre fichier des données selon différentes conditions
Réponses
3
Affichages
804
onyirimba
O
P
  • Question
XL 2016 Créer un tirage aléatoire, mais avec critères/conditions ?
Réponses
9
Affichages
941
patricktoulon
patricktoulon
T
  • Question
XL 2016 Problème de conditions
Réponses
1
Affichages
858
nat54
nat54
T
  • Question
XL 2019 Conditions multiples à partir de "textes + [quantités]" dans une cellule
Réponses
0
Affichages
895
titoun007
T

Membres actuellement en ligne

24 membres et 132 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 396
Messages
2 088 048
Membres
103 707
dernier inscrit
Papy60