Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro déduire test

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

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

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

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

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

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

job75

XLDnaute Barbatruc
Re,

En fait les résultats du fichier (1) concernaient le 1er tableau.

Si vous les voulez aussi pour le second tableau voyez ce fichier (2).

A+
 

Pièces jointes

  • test de résistance(2).xlsx
    85.7 KB · Affichages: 17
Vote positif 0 Vote négatif

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

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

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

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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
Autres que penses vous de ce mini test benchmark(timer plus precis)
Réponses
6
Affichages
597
patricktoulon
L
  • Question
Microsoft 365 recherche X lien entre 2 fichiers
Réponses
3
Affichages
181
lilie17
L
L
  • Question
XL 2019 Regroupement de données + envoi mail
Réponses
3
Affichages
201
loiclass
L
S
  • Résolu(e)
Microsoft 365 Power Query Lancer un ensemble de requetes sur plusieurs fichiers excel
Réponses
2
Affichages
528
Sokko
S
J
  • Question
Microsoft 365 Conversion de fichiers word en pdf / VBA
Réponses
1
Affichages
449
kiki29
G
  • Question
Microsoft 365 Répartition d'heures sous conditions
Réponses
5
Affichages
299
Guesh
G
M
  • Résolu(e)
Microsoft 365 Formules pour tableaux
Réponses
4
Affichages
395
Marvin57
M
C
  • Résolu(e)
XL 2016 Répartir dans des Groupes d'Effectifs Aléatoires ... mais pas trop
Réponses
2
Affichages
273
crocrocro
C
B
  • Question
XL 2021 Problème VBA
Réponses
8
Affichages
473
Bensi
B
P
  • Question
Microsoft 365 Tableau et condition inclusive comptabilité par mois
Réponses
1
Affichages
300
merinos-BernardEtang
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…