Code VBA boucle en fonction du contenu d'une cellule

Bonjour à tous,

Débutant vba je sollicite votre aide concernant un problème simple qui a peut être été résolu lors d'un sujet précédant.

Cependant étant donné mon niveau débutant il m'est difficile de faire le rapprochement.

Bref voici le problème que je cherche à résoudre.

Sous Excel j'ai 30 questions avec un nombre variable de réponses pour chaque question. Un nombre de point est attribué à chaque réponse.

Je souhaite faire le max et le min (des points liés aux réponses) de chaque question.

Si possible automatisé, c'est à dire en boucle jusqu'à ce qu'il n'y ai plus de questions.

Merci de votre aide

Ré bonjour,

Pour être plus claire je joins un fichier d'exemple. Ce n'est qu'un draft. J'ai fait le calcul souhaité en colonne F20 et F21 pour le min et maxi de chaque question mais je ne prends pas en compte les futurs question (et ce n'est pas automatique).

Merci pour votre aide

bonjour,

2 propositions: une avec formules et une avec vba

Sub aargh()
    smin = 0
    smax = 0
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To dl + 1
            If .Cells(i, 2) <> .Cells(i - 1, 2) Then
                smin = smin + mn
                mn = .Cells(i, 6)
                smax = smax + mx
                mx = mn
            Else
                If .Cells(i, 6) < mn Then mn = .Cells(i, 6)
                If .Cells(i, 6) > mx Then mx = .Cells(i, 6)
            End If
        Next i
        i = i + 1
        .Cells(i, 3) = "Somme des minima"
        .Cells(i, 6) = smin
        i = i + 1
        .Cells(i, 3) = "Somme des maxima"
        .Cells(i, 6) = smax
    End With
End Sub

Salut Jabsonfire,

Salut h2so4,

pas assez malin pour les formules mais en VBA, ma foi...

La macro démarre à chaque changement détecté en colonne [F] pour autant que [B] soit complété aussi.

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim iRow1%, iRow2%, iRowB%
If Not Intersect(Target, Range("F:F")) Is Nothing Then
    If Range("B" & Target.Row).Value <> "" And Range("F" & Target.Row).Value <> "" And Target.Row > 1 Then
        Union([A6], [A8]).Value = 0
        iRowB = Range("B" & Rows.Count).End(xlUp).Row
        Do
            iRow1 = IIf(iRow1 = 0, 2, iRow2 + 1)
            iRow2 = Range("B:B").Find(what:=Range("B" & iRow1).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
            [A6] = [A6] + WorksheetFunction.Min(Range("F" & iRow1 & ":F" & iRow2))
            [A8] = [A8] + WorksheetFunction.Max(Range("F" & iRow1 & ":F" & iRow2))
        Loop Until iRow1 = iRowB Or iRow2 = iRowB
    End If
End If
'
End Sub

A+

Bonjour à tous,

Excusez moi pour le délai de réponse !

C'est parfait ... J'ai même pu comprendre par moi même et adapter le code à mon besoin.

Ça m'encourage à continuer mon apprentissage.

Encore merci pour votre aide.

PS: je continu mon questionnaire et je vais avoir besoin d'aide concernant un autre sujet.

Donc je ferme celui-ci et j'en ouvre un autre : "VBA automatiser contenu case à cocher" si vous pouvez encore m'accorder votre aide ca sera avec grand plaisir.

Cordialement

Jabsonfire