Macro déduire test

[christine854]

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

 

[job75]

Bonjour le forum,

Pour éviter d'avoir à les recalculer quand c'est inutile il vaut mieux laisser les formules en colonne J (masquée) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D:J,R:R,AB:AB]) Is Nothing Then Exit Sub
Dim i As Variant, j As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
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) Then [J:J] = "" 'RAZ
If IsNumeric(i) And IsNumeric(j) Then
  If IsEmpty([J2]) Or Not Intersect(Target, [D:J]) Is Nothing Then
    [J:J] = "" 'RAZ
    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%))"
  End If
  With Range("AB2:AB" & j)
    .Formula = "=VLOOKUP(R2,D2:J" & i & ",7,0)" 'RECHERCHEV
    .Value = .Value
    .Interior.ColorIndex = 44
  End With
End If
With Me.UsedRange: End With 'actualise les barres de défilement
Application.EnableEvents = True 'réactive les évènements
End Sub

Comme la colonne AB la colonne J ne peut pas être modifiée manuellement.

Fichier (3).

Edit : le gain sur la durée d'exécution est de l'ordre de 50%, chez moi sur Win 10 - Excel 2013 :

- modification en colonnes D:J => 0,051 seconde (mais 0,009 s sans les RAZ ni la couleur)

- modification en colonnes R ou AB => 0,024 seconde (mais 0,001 s sans les RAZ ni la couleur).

Bonne journée.

 

[Paf]

re bonjour à tous

la dernière version qui permet de s'affranchir d'un tableau, et corrige l'erreur de colonne des résultats:

Sub TestR()
Dim T1, T2, i As Long, j As Long, k As Long, TR, 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)
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 + 2 ^ (k - 1)
                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("AA2").Resize(UBound(T2), 1) = T2
End With
End Sub

A+

 

[job75]

Bonjour christine854, Paf,

Bon dans ce fichier (3 bis) j'ai simplifié la formule en J2 :

=REPT("A";(E2>25%)*(F2>25%)*(G2>25%))&REPT("B";(E2>25%)*(F2>25%)*(G2<=25%))&REPT("C";(E2>25%)*(F2<=25%)*(G2>25%))&REPT("D";(E2<=25%)*(F2>25%)*(G2>25%))&REPT("E";(E2>25%)*(F2<=25%)*(G2<=25%))&REPT("F";(E2<=25%)*(F2>25%)*(G2<=25%))&REPT("G";(E2<=25%)*(F2<=25%)*(G2>25%))&REPT("H";(E2<=25%)*(F2<=25%)*(G2<=25%)*(H2>25%))

et bien sûr aussi la formule du VBA :

    Range("J2:J" & i) = "=REPT(""A"",(E2>25%)*(F2>25%)*(G2>25%))&REPT(""B"",(E2>25%)*(F2>25%)*(G2<=25%))&REPT(""C"",(E2>25%)*(F2<=25%)*(G2>25%))&REPT(""D"",(E2<=25%)*(F2>25%)*(G2>25%))&REPT(""E"",(E2>25%)*(F2<=25%)*(G2<=25%))&REPT(""F"",(E2<=25%)*(F2>25%)*(G2<=25%))&REPT(""G"",(E2<=25%)*(F2<=25%)*(G2>25%))&REPT(""H"",(E2<=25%)*(F2<=25%)*(G2<=25%)*(H2>25%))"

Cela fait gagner 0,004 seconde sur le calcul des formules en colonne J.

Edit : il manquait aussi des signes $ dans la formule de la colonne AB :

    .Formula = "=VLOOKUP(R2,D$2:J$" & i & ",7,0)" 'RECHERCHEV

A+

 

[christine854]

super ça marche parfaitement après avoir fait quelque test
un grand merci