Afficher une valeur précise sur un tableau Excel

Question

Bonjour,
On me demande de produire une macro qui renvoie la première commune de la liste qui correspond à ce code (suivant un code qu'on a mis au préalable). Et que si la commune n’existe pas, alors d'afficher un message « Code non valide ».
Pour afficher le mesasge je pense connaitre mais quand il s'agit du reste je n'ai aucune idée.

Ensuite on me demande Produire une macro nommée « qui compte le nombre de fois que chaque code apparait dans le tableau. Le résultat doit être stocké sur une nouvelle feuille. Résultat sous forme d’un tableau de deux colonnes : la première colonne contient les codes postaux (sans redondance) et la deuxième colonne contient le nombre de fois que chaque code apparait dans le tableau de la feuille DATA.
Là encore je n'ai aucune idée.
Si vous avez des pistes par hasard je vous en serai reconnaissant.

ThauThème · Answer

Bonjour Sieg, bonjour le forum,

Tiens ! Encore un exercice... En principe je laisse aux étudiants résoudre leur problème mais comme je m'em***de un peu en ce moment ... Ne m'engueulez pas !...

• Problème 1 , méthode 1 (variable tableau) :

Sub Macro1()
Dim OD As Worksheet 'déclare la variable OD (Onglet Data)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim BEC As Variant 'déclare la variable BEC (Boîte d'Entrée Code)
Dim I As Long 'déclare la variable I (Incrément)

Set OD = Worksheets("DATA_CC") 'définit l'onglet OD
TV = OD.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
BEC = Application.InputBox("Taper le code.", "CODE", Type:=1) 'définit la boîte d'entrée BEC
If BEC = False Then Exit Sub 'si bouton [Annuler], sort de la procédure
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 1) = BEC Then OD.Cells(I, 1).Select: Exit Sub 'si la donnée ligne I colonne 1 de TV est égale à la boîte d'entrée BEC, sélectionne la cellule Ligne I colonne 1 de l'onglet OD, sort de la procédure
Next I 'prochaine ligne de la boucle
MsgBox "Code non valide !" 'message
End Sub

Problème 1 , méthode 2 (Recherche Find) :

Sub Macro2()
Dim OD As Worksheet 'déclare la variable OD (Onglet Data)
Dim PL As Range 'déclare la variable PL (PLage)
Dim BEC As Variant 'déclare la variable BEC (Boîte d'Entrée Code)
Dim R As Range 'déclare la variable R (Recherche)

Set OD = Worksheets("DATA_CC") 'définit l'onglet OD
Set PL = OD.Range("A1").CurrentRegion 'définit la plage PL
BEC = Application.InputBox("Taper le code.", "CODE", Type:=1) 'définit la boîte d'entrée BEC
If BEC = False Then Exit Sub 'si bouton [Annuler], sort de la procédure
Set R = OD.Columns(1).Find(BEC, , xlValues, xlWhole) 'définit la recherche R (recherche la valeur exacte de la boîte d'entrée BEC dans la colonne 1 de l'onglet OD)
If Not R Is Nothing Then 'condition : s'il existe au moins une occurrence trouvée
    OD.Cells(R.Row, 1).Select 'sélectionne la cellule de la ligne de la première occurrence trouvée colonne 1 de l'onglet OD
Else 'sinon
    MsgBox "Code non valide !" 'message
End If 'fin de la condition
End Sub

J'ai l'impression que la méthode 1 est paradoxalement plus rapide...

• Problème 2 :

Sub Macro3()
Dim OD As Worksheet 'déclare la variable OD (Onglet Data)
Dim OT As Worksheet 'déclare la variable OT (Onglet Tableau)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)

Set OD = Worksheets("DATA_CC") 'définit l'onglet OD
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set OT = Worksheets("Tableau") 'définit l'onglet OT (génère une erreur si cet onglet n'existe pas)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Worksheets.Add after:=Sheets(Sheets.Count) 'ajoute un nouvel onglet en dernière position
    Set OT = ActiveSheet 'définit l'onglet OT
    OT.Name = "Tableau" 'renomme l'onglet OT
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
OT.Cells.ClearContents 'efface le contenu de l'onglet OT
TV = OD.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = D(TV(I, 1)) + 1 'alimente le dictionnaire D
Next I 'prochaine ligne de la boucle
OT.Range("A1").Value = "Code Postal" 'Texte en A1
OT.Range("B1").Value = "Nombre" 'Texte en B1
OT.Range("A2").Resize(D.Count).Value = Application.Transpose(D.Keys) 'renvoie en A2 redimensionnée la liste des éléments du dictionnaire D sans doublon
OT.Range("B2").Resize(D.Count).Value = Application.Transpose(D.items) 'renvoie en B2 redimensionnée le nombre de fois que les éléments du dictionnaire D sans doublon apparaissent
OT.Columns("A:B").AutoFit 'auto ajustement des colonnes A et B
End Sub