Exercice VBA impossible à faire

Bonjour à tous, un ami n'a pas réussi à trouver la solution à cet exercice et je ne vous cache pas que moi non plus.

Quelqu'un d'assez expérimenté en VBA y arriverait? La solution m'intrigue

Merci !

Bonjour,

Une solution Power Query et VBA ?

Cdlt.

Bonjour,

Hello Jean-Eric, ça faisait un bail !

Petit essai très amateur (et pour respecter ce principe de boucle, demandé dans l'exercice. Il peut être pédagogiquement intéressant d'essayer de trouver des améliorations petit à petit d'ailleurs).

Sub test()
Dim annee, client
Dim choix As String
[B2:AE17].ClearContents
Application.ScreenUpdating = False

choix = "NON"
If [C22] = True Then choix = "OUI"
For Each cell In Feuil1.Range("C2:C30001")
    If cell = choix Then
        annee = Year(cell.Offset(, -2))
        client = cell.Offset(, -1) + 1
Feuil2.Cells(annee - 2009, client) = Feuil2.Cells(annee - 2009, client) + 1
End If
Next
End Sub

Ça dépend aussi un peu du niveau de la formation et du type de cours :

Si le cours et l'exercice porte sur les Array ou les Dictionnary, on va surement résoudre le problème différemment...

Précisez SVP !

A+

Là j'ai eu l'impression que c'était plutôt un niveau débutant.
Mais en relisant bien la consigne, je pense que je n'ai pas répondu à ce qui était demandé.

Mais pour répondre littéralement à la question, j'ai l'impression qu'il faut enquiller un sacré paquet de boucles ...

Voici une solution pour "OUI" avec les Array :

Sub Comptage()
Dim TBD, ArrC
Dim iRS&, iCC&, rngS As Range, rngC As Range
Set rngS = Feuil1.[A1].CurrentRegion
With rngS
    Set rngS = .Offset(1).Resize(.Rows.Count - 1)
End With
TBD = rngS.Value

Set rngC = Feuil2.[A1].CurrentRegion
With rngC
    Set rngC = .Offset(1).Resize(.Rows.Count - 1)
End With
ArrC = rngC.Value
For iRS = 1 To UBound(TBD)
   If TBD(iRS, 3) = "OUI" Then
      iAn = Year(TBD(iRS, 1))
      iCC = TBD(iRS, 2) + 1
      ArrC(iAn - 2010, iCC) = ArrC(iAn - 2010, iCC) + 1
   End If
Next
rngC.Value = ArrC
End Sub

A+

Salut Grégoire,
Salut l'équipe,

un petit tri, une petite boucle...
Pas besoin de bouton, il suffit de choisir l'option désirée...

Public Sub Calcul(ByVal iIdx%)
'
Dim tTab, tBDD, lgRow&
'
Range("B2:AE17").Value = ""
tTab = Range("B2:AE17").Value
'
With Worksheets("BDD")
    .Range("A1:C" & .Range("A" & Rows.Count).End(xlUp).Row).Sort _
        key1:=.[C2], order1:=IIf(iIdx = 1, xlDescending, xlAscending), _
        key2:=.[B2], order2:=xlAscending, _
        key3:=.[A2], order3:=xlAscending, _
        Orientation:=xlTopToBottom, Header:=xlYes
    lgRow = .Columns(3).Find(what:=IIf(iIdx = 1, "OUI", "NON"), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
    tBDD = .Range("A2:C" & lgRow).Value
End With
'
For x = 1 To UBound(tBDD, 1)
    tTab(Year(CDate(tBDD(x, 1))) - 2010, CInt(tBDD(x, 2))) = CInt(tTab(Year(CDate(tBDD(x, 1))) - 2010, CInt(tBDD(x, 2)))) + 1
Next
Range("B2:AE17").Value = tTab
'
End Sub

A+

2 solutions pour le prix d'une !

Bonjour,

Apparemment on a été plus intéressé par le sujet, que Grégoire par nos réponses.