Macro déduire test

christine854

christine854

XLDnaute Junior
Bonjour à tous

J'ai un classeur sur lequel j'aimerai déduire en fonction des tests réussie un test final

J'ai une série de tests (test 1, 2, 3 et 4) en fonction des tests réussis (supérieur a 25 %) j'aimerais en déduire le test de résistance

Exemple : si test 1, 2 et 3 réussis alors test A
 

Pièces jointes

  • test de résistance.xlsx
    78.5 KB · Affichages: 22
Trier par date Trier par votes
Paf

Paf

XLDnaute Barbatruc
Bonjour christine854, Hieu,

un essai par fonction personnalisée:

en AA2 : =TestResistance($D$2:$H$293;Q2) et tirer vers le bas

et dans un module standard:

VB: 
Function TestResistance(Plage, Produit)
Dim T As String
For Each ligne In Plage.Rows
    If ligne.Cells(1, 1) = Produit Then
        For i = 2 To Plage.Columns.Count
            If ligne.Cells(1, i) > 0.25 Then
                 T = T & i - 1 & "|"
            End If
        Next
        Exit For
    End If
Next
                  
Select Case T
    Case "1|2|3|"
            TestResistance = "Résistance A"
    Case "1|2|"
            TestResistance = "Résistance B"
    Case "1|3|"
            TestResistance = "Résistance C"
    Case "2|3|"
            TestResistance = "Résistance D"
    Case Else
        TestResistance = "--"
End Select
End Function

Pas pris en compte les tests de résistance E,F,G et H car pas compris ce qu'est la réussite à la catégorie 1,2,3 ou 4

A+
 
Vote positif 0 Vote négatif
christine854

christine854

XLDnaute Junior
c'est pour chaque code produit j'ai différent résultat de test (de la colonne E a I, les code produit sont en colonne D)
Pour chaque test associé a un code produit si il est supérieur a 25% le test est réussit (résultat en colonne E,F,G,H)
j'aimerai qu'en colonne AA pour chaque code produit correspondant de la colonne Q en déduire en fonction des test réussit le test de résistance associé
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re,

Si j'ai bien compris réussite au test 1 ou à la catégorie 1 c'est la même chose ?

Avec l'ensemble des critères :
VB: 
Function TestResistance(Plage, Produit)
Dim T As String
Application.Volatile
For Each ligne In Plage.Rows
    If ligne.Cells(1, 1) = Produit Then
        For i = 2 To Plage.Columns.Count
            If ligne.Cells(1, i) > 0.25 Then
            T = T & i - 1 & "|"
            End If
        Next
        Exit For
    End If
Next
                 
Select Case T
    Case "1|", "1|4|"
            TestResistance = "Resistance E"
    Case "2|", "2|4|"
            TestResistance = "Resistance F"
    Case "3|", "3|4|"
            TestResistance = "Resistance G"
    Case "4|"
            TestResistance = "Resistance H"
    Case "1|2|3|", "1|2|3|4|"
            TestResistance = "Resistance A"
    Case "1|2|", "1|2|4|"
            TestResistance = "Resistance B"
    Case "1|3|", "1|3|4|"
            TestResistance = "Resistance C"
    Case "2|3|", "2|3|4|"
            TestResistance = "Resistance D"
    Case Else
        TestResistance = "--"
End Select
End Function

A+

Edit : Bonjour job75
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour christine854, Hieu, Paf,

C'est typiquement le cas où ce problème se résout très facilement par formule.

Voyez le fichier joint et cette formule en AA2 :
Code: 
=REPT("A";SIGNE((E2>25%)*(F2>25%)*(G2>25%)*(H2<=25%)+(E2>25%)*(F2>25%)*(G2>25%)*(H2>25%)))&REPT("B";SIGNE((E2>25%)*(F2>25%)*(G2<=25%)*(H2<=25%)+(E2>25%)*(F2>25%)*(G2<=25%)*(H2>25%)))&REPT("C";SIGNE((E2>25%)*(F2<=25%)*(G2>25%)*(H2<=25%)+(E2>25%)*(F2<=25%)*(G2>25%)*(H2>25%)))&REPT("D";SIGNE((E2<=25%)*(F2>25%)*(G2>25%)*(H2<=25%)+(E2<=25%)*(F2>25%)*(G2>25%)*(H2>25%)))&REPT("E";SIGNE((E2>25%)*(F2<=25%)*(G2<=25%)*(H2<=25%)+(E2>25%)*(F2<=25%)*(G2<=25%)*(H2>25%)))&REPT("F";SIGNE((E2<=25%)*(F2>25%)*(G2<=25%)*(H2<=25%)+(E2<=25%)*(F2>25%)*(G2<=25%)*(H2>25%)))&REPT("G";SIGNE((E2<=25%)*(F2<=25%)*(G2>25%)*(H2<=25%)+(E2<=25%)*(F2<=25%)*(G2>25%)*(H2>25%)))&REPT("H";(E2<=25%)*(F2<=25%)*(G2<=25%)*(H2>25%))
Une fois qu'on a bien compris le 1er REPT("A";xxx) les autres coulent de source.

On pourrait simplifier la formule mais c'est plus clair comme cela, on adapte comme on veut.

A+
 

Pièces jointes

  • test de résistance(1).xlsx
    84.8 KB · Affichages: 19
Dernière édition:
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
re,

le code proposé n'est pas une macro qui se lance, mais une fonction personnalisée.
Comme dit au post 3, on écrit la formule dans une cellule:
en AA2 : =TestResistance($D$2:$H$293;Q2) et tirer vers le bas

le code de la fonction est à copier dans un module standard.

Si vous préférez une macro à lancer, dans un module strandard :

VB: 
 Sub TestR()
Dim T1, T2, i As Long, j As Long, k As Long, T As String, Test As String
With Worksheets("Feuil1")
T1 = .Range("D2:H" & .Range("D" & Rows.Count).End(xlUp).Row - 1)
T2 = .Range("Q2:Q" & .Range("Q" & Rows.Count).End(xlUp).Row)
  
For i = 1 To UBound(T2, 1)
    T = ""
    For j = 1 To UBound(T1, 1)
        If T2(i, 1) = T1(j, 1) Then
            For k = 2 To UBound(T1, 2)
                If T1(j, k) > 0.25 Then
                    T = T & k - 1 & "|"
                End If
            Next
            Exit For
        End If
    Next
    Select Case T
    Case "1|", "1|4|"
            T2(i, 1) = "Resistance E"
    Case "2|", "2|4|"
            T2(i, 1) = "Resistance F"
    Case "3|", "3|4|"
            T2(i, 1) = "Resistance G"
    Case "4|"
            T2(i, 1) = "Resistance H"
    Case "1|2|3|", "1|2|3|4|"
            T2(i, 1) = "Resistance A"
    Case "1|2|", "1|2|4|"
            T2(i, 1) = "Resistance B"
    Case "1|3|", "1|3|4|"
            T2(i, 1) = "Resistance C"
    Case "2|3|", "2|3|4|"
            T2(i, 1) = "Resistance D"
    Case Else
        T2(i, 1) = "--"
    End Select
Next
.Range("AA2").Resize(UBound(T2), 1) = T2
End With
End Sub

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
re,

une modif sur la détermination de l'affichage de résistance:
VB: 
Sub TestR()
Dim T1, T2, i As Long, j As Long, k As Long, TR, TT, Result As Integer, Ind As Integer
With Worksheets("Feuil1")
T1 = .Range("D2:H" & .Range("D" & Rows.Count).End(xlUp).Row - 1)
T2 = .Range("Q2:Q" & .Range("Q" & Rows.Count).End(xlUp).Row)
TT = Array(2, 4, 8, 1)
TR = Array("H", "E", "F", "B", "G", "C", "D", "A")
For i = 1 To UBound(T2, 1)
    Result = 0
    For j = 1 To UBound(T1, 1)
        If T2(i, 1) = T1(j, 1) Then
            For k = 2 To UBound(T1, 2)
                If T1(j, k) > 0.25 Then
                    If k < UBound(T1, 2) Then
                        Result = Result + TT(k - 2)
                    Else
                        If Result = 0 Then Result = TT(k - 2)
                    End If
                End If
            Next
            Exit For
        End If
    Next
    If Result = 0 Then
      T2(i, 1) = " - - "
    Else
        Ind = (Result) / 2
        T2(i, 1) = " Résistance " & TR(Ind)
    End If
Next
.Range("AB2").Resize(UBound(T2), 1) = T2
End With
End Sub

A+
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
re,

la même ou presque:
VB: 
Sub TestR()
Dim T1, T2, i As Long, j As Long, k As Long, TR, TT, Result As Integer, Ind As Integer
With Worksheets("Feuil1")
T1 = .Range("D2:H" & .Range("D" & Rows.Count).End(xlUp).Row - 1)
T2 = .Range("Q2:Q" & .Range("Q" & Rows.Count).End(xlUp).Row)
TT = Array(2, 4, 8, 16)
TR = Array("H", "E", "F", "B", "G", "C", "D", "A")
For i = 1 To UBound(T2, 1)
    Result = 0
    For j = 1 To UBound(T1, 1)
        If T2(i, 1) = T1(j, 1) Then
            For k = 2 To UBound(T1, 2)
                If T1(j, k) > 0.25 Then
                    Result = Result + TT(k - 2)
                End If
            Next
            Exit For
        End If
    Next
    If Result = 0 Then
      T2(i, 1) = " - - "
    Else
        Ind = IIf(Result >= 16, (Result - 16) / 2, Result / 2)
        T2(i, 1) = " Résistance " & TR(Ind)
    End If
Next
.Range("AB2").Resize(UBound(T2), 1) = T2
End With
End Sub

A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

On peut utiliser les formules du fichier (2) en VBA :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D:H,R:R]) Is Nothing Then Exit Sub
Dim i As Variant, j As Variant
Application.ScreenUpdating = False
Range("AB2:AB" & Rows.Count) = "" 'RAZ
Range("AB2:AB" & Rows.Count).Interior.ColorIndex = xlNone
i = Application.Match(9 ^ 9, [D:D])
j = Application.Match(9 ^ 9, [R:R])
If Not IsNumeric(i) Or Not IsNumeric(j) Then Exit Sub
Range("J2:J" & i) = "=REPT(""A"",SIGN((E2>25%)*(F2>25%)*(G2>25%)*(H2<=25%)+(E2>25%)*(F2>25%)*(G2>25%)*(H2>25%)))&REPT(""B"",SIGN((E2>25%)*(F2>25%)*(G2<=25%)*(H2<=25%)+(E2>25%)*(F2>25%)*(G2<=25%)*(H2>25%)))&REPT(""C"",SIGN((E2>25%)*(F2<=25%)*(G2>25%)*(H2<=25%)+(E2>25%)*(F2<=25%)*(G2>25%)*(H2>25%)))&REPT(""D"",SIGN((E2<=25%)*(F2>25%)*(G2>25%)*(H2<=25%)+(E2<=25%)*(F2>25%)*(G2>25%)*(H2>25%)))&REPT(""E"",SIGN((E2>25%)*(F2<=25%)*(G2<=25%)*(H2<=25%)+(E2>25%)*(F2<=25%)*(G2<=25%)*(H2>25%)))&REPT(""F"",SIGN((E2<=25%)*(F2>25%)*(G2<=25%)*(H2<=25%)+(E2<=25%)*(F2>25%)*(G2<=25%)*(H2>25%)))&REPT(""G"",SIGN((E2<=25%)*(F2<=25%)*(G2>25%)*(H2<=25%)+(E2<=25%)*(F2<=25%)*(G2>25%)*(H2>25%)))&REPT(""H"",(E2<=25%)*(F2<=25%)*(G2<=25%)*(H2>25%))"
With Range("AB2:AB" & j)
  .Formula = "=VLOOKUP(R2,D:J,7,0)"
  .Value = .Value
  .Interior.ColorIndex = 44
End With
[J:J] = ""
End Sub
La colonne J, qui reçoit (temporairement) la grande formule, est masquée.

La colonne AB est renseignée automatiquement quand on modifie des données en colonnes D à H ou R.

Fichier joint.

A+
 

Pièces jointes

  • test de résistance par VBA(1).xlsm
    91 KB · Affichages: 12
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Une solution meilleure dans ce fichier (2) :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D:H,Q:Q,AA:AA]) Is Nothing Then Exit Sub
Dim i As Variant, j As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Range("AA2:AA" & Rows.Count) = "" 'RAZ
Range("AA2:AA" & Rows.Count).Interior.ColorIndex = xlNone
i = Application.Match(9 ^ 9, [D:D])
j = Application.Match(9 ^ 9, [Q:Q])
If IsNumeric(i) And IsNumeric(j) Then
  Range("IV2:IV" & i) = "=REPT(""A"",SIGN((E2>25%)*(F2>25%)*(G2>25%)*(H2<=25%)+(E2>25%)*(F2>25%)*(G2>25%)*(H2>25%)))&REPT(""B"",SIGN((E2>25%)*(F2>25%)*(G2<=25%)*(H2<=25%)+(E2>25%)*(F2>25%)*(G2<=25%)*(H2>25%)))&REPT(""C"",SIGN((E2>25%)*(F2<=25%)*(G2>25%)*(H2<=25%)+(E2>25%)*(F2<=25%)*(G2>25%)*(H2>25%)))&REPT(""D"",SIGN((E2<=25%)*(F2>25%)*(G2>25%)*(H2<=25%)+(E2<=25%)*(F2>25%)*(G2>25%)*(H2>25%)))&REPT(""E"",SIGN((E2>25%)*(F2<=25%)*(G2<=25%)*(H2<=25%)+(E2>25%)*(F2<=25%)*(G2<=25%)*(H2>25%)))&REPT(""F"",SIGN((E2<=25%)*(F2>25%)*(G2<=25%)*(H2<=25%)+(E2<=25%)*(F2>25%)*(G2<=25%)*(H2>25%)))&REPT(""G"",SIGN((E2<=25%)*(F2<=25%)*(G2>25%)*(H2<=25%)+(E2<=25%)*(F2<=25%)*(G2>25%)*(H2>25%)))&REPT(""H"",(E2<=25%)*(F2<=25%)*(G2<=25%)*(H2>25%))"
  With Range("AA2:AA" & j)
    .Formula = "=INDEX(IV:IV,MATCH(Q2,D:D,0))" 'INDEX/EQUIV
    .Value = .Value
    .Interior.ColorIndex = 44
  End With
  [IV:IV] = ""
End If
With Me.UsedRange: End With 'actualise les barres de défilement
Application.EnableEvents = True 'réactive les évènements
End Sub
La colonne auxiliaire J est remplacée par la colonne IV.

Une fois créées les données de la colonne AA ne peuvent plus être modifiées.

Bonne fin de soirée.
 

Pièces jointes

  • test de résistance par VBA(2).xlsm
    90.8 KB · Affichages: 13
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Power Query Lancer un ensemble de requetes sur plusieurs fichiers excel
Réponses
2
Affichages
267
Sokko
S
J
  • Question
Microsoft 365 Conversion de fichiers word en pdf / VBA
Réponses
1
Affichages
159
kiki29
kiki29
M
  • Résolu(e)
Microsoft 365 Formules pour tableaux
Réponses
4
Affichages
186
Marvin57
M
P
  • Question
Microsoft 365 Tableau et condition inclusive comptabilité par mois
Réponses
1
Affichages
120
merinos
merinos
3
  • Question
XL 2013 Recherche a plusieurs critéres
Réponses
2
Affichages
219
Gégé-45550
Gégé-45550
B
  • Résolu(e)
XL 2019 Fonction Match
2
Réponses
17
Affichages
747
JM27
J
D
  • Question
Microsoft 365 VBA pour ajouter des données dans Bases de données
Réponses
9
Affichages
392
Oneida
Oneida
D
  • Question
XL 2016 Classement BLIND Test 30 équipes
Réponses
5
Affichages
226
Modeste geedee
Modeste geedee
Usine à gaz
  • Résolu(e)
XL 2021 de la colonne B, ne garder que les communes et cp à mettre en colonne C
Réponses
10
Affichages
309
Usine à gaz
Usine à gaz
lynyrd
  • Résolu(e)
XL 2016 Supprimer 1 sur 13
Réponses
6
Affichages
122
lynyrd
lynyrd

Membres actuellement en ligne

15 membres et 351 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 095
Messages
2 085 249
Membres
102 835
dernier inscrit
Alexandrax971