Macro déduire test

christine854 · 27 Décembre 2016

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 · 28 Décembre 2016

Bonjour le forum,

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

Code:

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 · 28 Décembre 2016

re bonjour à tous

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

VB:

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 · 29 Décembre 2016

Bonjour christine854, Paf,

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

Code:

=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 :

Code:

    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 :

Code:

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

A+

christine854 · 5 Janvier 2017

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

Macro déduire test

christine854

XLDnaute Junior

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Paf

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

christine854

XLDnaute Junior

Discussions similaires