Vous avez apprécié ?
Cliquez ;-)

Cours VBA : utilisations des tableaux (exercice)

Pour mettre en pratique l'utilisation des tableaux, vous allez réaliser par étapes la macro qui a servi d'exemple pour démontrer la rapidité des tableaux ...

Voici le point de départ de l'exercice (la base de données a été réduite à 1000 lignes) :

Le fichier : tableaux_exercice.xls


bd - tableaux vba exercice

Objectif de l'exercice : la procédure devra parcourir la base de données en boucle et comptabiliser pour chaque année et chaque n° de client le nombre de "OUI" ou "NON" (selon le choix de l'utilisateur) et entrer ce décompte dans la cellule correspondante.

res - tableaux vba exercice

Complétez la macro suivante pour enregistrer la base de données de la feuille "BD" dans un tableau :

Sub mettre_a_jour()
    Dim derniere_ligne As Integer
   
    'Dernière ligne de la base de données
    '...
       
    'Enregistrement de la base de données dans un tableau dynamique
    Dim tab_bd()
    '...
       
End Sub

.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.

Une solution :

Sub mettre_a_jour()
    Dim derniere_ligne As Integer
   
    'Dernière ligne de la base de données
    derniere_ligne = Sheets("BD").Range("A1").End(xlDown).Row

    'Enregistrement de la base de données dans un tableau dynamique
    Dim tab_bd()
    ReDim tab_bd(derniere_ligne - 2, 2)
   
    For ligne = 2 To derniere_ligne
        tab_bd(ligne - 2, 0) = Sheets("BD").Range("A" & ligne)
        tab_bd(ligne - 2, 1) = Sheets("BD").Range("B" & ligne)
        tab_bd(ligne - 2, 2) = Sheets("BD").Range("C" & ligne)
    Next
End Sub

Il ne s'agit là que d'une répétition de ce qui a été vu à la page précédente ...

Il va maintenant falloir transformer cette macro pour :

  • Déterminer le choix de l'utilisateur ("OUI" ou "NON")
  • Calculer le nombre de "OUI" ou "NON" de la base de données pour définir la taille du tableau (Redim)
  • Enregistrer dans le tableau uniquement les lignes de la base de données avec "OUI" ou "NON" (il n'est donc plus utile d'enregistrer la 3e colonne)

.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.

Une solution :

Sub mettre_a_jour()
    Dim derniere_ligne As Integer, valeur_recherchee As String, ligne_insertion As Integer, valeur_oui_non As String, taille As Integer
   
    'Dernière ligne de la base de données
    derniere_ligne = Sheets("BD").Range("A1").End(xlDown).Row

    'Valeur recherchée (OUI ou NON)
    If Sheets("RES").OptionButton_oui.Value = True Then
        valeur_recherchee = "OUI"
    Else
        valeur_recherchee = "NON"
    End If
   
    'Nombre de OUI ou NON
    taille = WorksheetFunction.CountIf(Sheets("BD").Range("C2:C" & derniere_ligne), valeur_recherchee)
   
    'Enregistrement de la base de données dans un tableau
    Dim tab_bd()
    ReDim tab_bd(taille - 1, 1)

    ligne_insertion = 0
   
    For ligne = 2 To derniere_ligne
        valeur_oui_non = Sheets("BD").Range("C" & ligne)
        If valeur_oui_non = valeur_recherchee Then
            tab_bd(ligne_insertion, 0) = Sheets("BD").Range("A" & ligne)
            tab_bd(ligne_insertion, 1) = Sheets("BD").Range("B" & ligne)
            ligne_insertion = ligne_insertion + 1
        End If
    Next
End Sub

Le choix de l'utilisateur est tout d'abord déterminé grâce à :

'Valeur recherchée (OUI ou NON)
If Sheets("RES").OptionButton_oui.Value = True Then
    valeur_recherchee = "OUI"
Else
    valeur_recherchee = "NON"
End If

La fonction NB.SI (Countif) a été utilisée pour calculer le nombre de OUI ou de NON :

'Nombre de OUI ou NON
taille = WorksheetFunction.CountIf(Sheets("BD").Range("C2:C" & derniere_ligne), valeur_recherchee)

La taille du tableau a été adaptée au nombre de OUI ou de NON et réduite à 2 colonnes :

ReDim tab_bd(taille - 1, 1)

Les données sont ensuite enregistrées dans le tableau si la valeur de la 3e colonne correspond au choix de l'utilisateur :

'N° d'insertion dans le tableau
ligne_insertion = 0

'Parcours de la base de données
For ligne = 2 To derniere_ligne
    'Valeur de la colonne C (OUI ou NON)
    valeur_oui_non = Sheets("BD").Range("C" & ligne)
    'Si la valeur correspond au choix de l'utilisateur, la ligne est enregistrée
    If valeur_oui_non = valeur_recherchee Then
        'Enregistrement de la valeur de la colonne A
        tab_bd(ligne_insertion, 0) = Sheets("BD").Range("A" & ligne)
        'Enregistrement de la valeur de la colonne B
        tab_bd(ligne_insertion, 1) = Sheets("BD").Range("B" & ligne)
        'Une ligne a été enregistrée => le n° d'insertion dans le tableau augmente de 1
        ligne_insertion = ligne_insertion + 1
    End If
Next

Le tableau ne contient plus que les données qui nous intéressent.

Il nous reste encore à :

  • Parcourir chaque cellule du "tableau" de la feuille "RES" à l'aide de 2 boucles (même principe que l'exercice du damier)
  • Et y ajouter le nombre total d'entrées du tableau correspondant à l'année et au n° de client pour chaque cellule

.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.

Une solution :

'Décomptes de "OUI"/"NON"
For annee = 2011 To 2026
    For no_client = 1 To 30
        compteur = 0
        For i = 0 To UBound(tab_bd)
            If Year(tab_bd(i, 0)) = annee And tab_bd(i, 1) = no_client Then
                compteur = compteur + 1
            End If
        Next
        Cells(annee - 2009, no_client + 1) = compteur
    Next
Next

La solution en détails :

'Boucle pour chaque ligne
For annee = 2011 To 2026
    'Boucle pour chaque colonne
    For no_client = 1 To 30
        'Compteur réinitialisé
        compteur = 0
        'Parcours du tableau
        For i = 0 To UBound(tab_bd)
            'Vérifie si la ligne du tableau correspond à l'année et au n° de client
            If Year(tab_bd(i, 0)) = annee And tab_bd(i, 1) = no_client Then
                'Si l'année et le n° de client correspondent, le compteur augmente de 1
                compteur = compteur + 1
            End If
        Next
        'Après avoir parcouru le tableau, le total est entré dans la cellule correspondante
        Cells(annee - 2009, no_client + 1) = compteur
    Next
Next

Et pour finir, la macro complète :

Sub mettre_a_jour()
    Dim derniere_ligne As Integer, valeur_recherchee As String, ligne_insertion As Integer, valeur_oui_non As String, taille As Integer, compteur As Integer
   
    'Suppression du contenu
    Range("B2:AE17").ClearContents
   
    'Dernière ligne de la base de données
    derniere_ligne = Sheets("BD").Range("A1").End(xlDown).Row

    'Valeur recherchée (OUI ou NON)
    If Sheets("RES").OptionButton_oui.Value = True Then
        valeur_recherchee = "OUI"
    Else
        valeur_recherchee = "NON"
    End If
   
    'Nombre de OUI ou NON
    taille = WorksheetFunction.CountIf(Sheets("BD").Range("C2:C" & derniere_ligne), valeur_recherchee)
   
    'Enregistrement de la base de données dans un tableau
    Dim tab_bd()
    ReDim tab_bd(taille - 1, 1)

    ligne_insertion = 0
   
    For ligne = 2 To derniere_ligne
        valeur_oui_non = Sheets("BD").Range("C" & ligne)
        If valeur_oui_non = valeur_recherchee Then
            tab_bd(ligne_insertion, 0) = Sheets("BD").Range("A" & ligne)
            tab_bd(ligne_insertion, 1) = Sheets("BD").Range("B" & ligne)
            ligne_insertion = ligne_insertion + 1
        End If
    Next
   
    'Décomptes de OUI ou NON
    For annee = 2011 To 2026
        For no_client = 1 To 30
            compteur = 0
            For i = 0 To UBound(tab_bd)
                If Year(tab_bd(i, 0)) = annee And tab_bd(i, 1) = no_client Then
                    compteur = compteur + 1
                End If
            Next
            Cells(annee - 2009, no_client + 1) = compteur
        Next
    Next
End Sub

Et le fichier : tableaux_exercice_complete.xls

exercice - tableaux vba exercice