Scripting Dictionary (même item sur différentes keys)
Résolu
Identifiant_Anonyme
Messages postés
12
Statut
Membre
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour à tous,
Je travaille sur un fichier assez mal fichu et énooorme, que je ne peux absolument pas modifié (il y a beaucoup de cellules vides, le même pays revient parfois plus loin...) et je dois faire avec). :-((
Bref, j'ai créé un scripting.dictionary adapté à ce fichier pour recenser des villes par pays.
Je crois que ça fonctionne, sauf qu'il y a des villes qui existent dans plusieurs pays, et là mon dictionnaire bloque.
Un des buts du fichier sera de mettre en évidence ces villes qui se trouvent dans plusieurs pays (j'ai mis en rouge les commentaires), mais pour l'instant, ma question est simplement : Mais où est l'erreur qui m'empêche de terminer mon dictionnaire ??
Quelqu'un saurait-il m'aider ?
Je joins un modèle réduit de ce fameux fichier.
Merci beaucoup.
https://www.cjoint.com/?3Ftq0B1dlrw
Je travaille sur un fichier assez mal fichu et énooorme, que je ne peux absolument pas modifié (il y a beaucoup de cellules vides, le même pays revient parfois plus loin...) et je dois faire avec). :-((
Bref, j'ai créé un scripting.dictionary adapté à ce fichier pour recenser des villes par pays.
Je crois que ça fonctionne, sauf qu'il y a des villes qui existent dans plusieurs pays, et là mon dictionnaire bloque.
Un des buts du fichier sera de mettre en évidence ces villes qui se trouvent dans plusieurs pays (j'ai mis en rouge les commentaires), mais pour l'instant, ma question est simplement : Mais où est l'erreur qui m'empêche de terminer mon dictionnaire ??
Quelqu'un saurait-il m'aider ?
Je joins un modèle réduit de ce fameux fichier.
Merci beaucoup.
https://www.cjoint.com/?3Ftq0B1dlrw
2 réponses
-
Bonjour,
Je ne m'attendais pas à une réponse si rapide... Merci.
Mon codage ne devait pas être très bon (pusique tu l'as modifié), je vais donc essayer de comprendre les éléments qui me sont inconnus (Redim et UBound, au moins), et ensuite j'essayerais de continuer.
Merci beaucoup, déjà, c'est très aimable.
Je place en Résolu et reviendrai éventuellement si je bloque encore.
I:I-
Bonjour
Je ne m'attendais pas à une réponse si rapide... Merci.
Le problème m'avait branché ;o)
pour des explications sur Ubound et Redim voir ce tuto très complet
https://silkyroad.developpez.com/vba/tableaux/
-
-
Bonjour,
une alternative:
Ci joint proposition donnant les pays par villes ( les clés du dico sont les villes)
https://www.cjoint.com/?3FtwpBgsD7L
Attention à la casse dans "dans le pays ....."
la macro (on devrait peut-^tre aller + vite mais...)Option Explicit
Michel
Option Base 1
Sub lister_Pays_par_ville()
Dim Nbre As Integer
Dim T_pays, Cptr_a As Integer, Lig As Long
Dim D_ville As Object, Cptr_b As Integer, Ville As String
'initialisations
Application.ScreenUpdating = False
Range("G2:H1000").Clear
Set D_ville = CreateObject("scripting.dictionary")
Nbre = Application.CountIf(Columns("A"), "*dans le pays*")
ReDim T_pays(Nbre, 3)
Lig = Rows.Count
For Cptr_a = 1 To Nbre
'limites par pays
Lig = Columns("A").Find("dans le pays", Cells(Lig, "A")).Row
T_pays(Cptr_a, 1) = Lig
If Cptr_a = UBound(T_pays) Then
T_pays(Cptr_a, 2) = Columns("A").Find("*", , , , , xlPrevious).Row
Else
T_pays(Cptr_a, 2) = Columns("A").Find("dans le pays", Cells(Lig, "A")).Row
End If
'nom pays 'SENSIBLE A LA CASSE
T_pays(Cptr_a, 3) = Application.Substitute(Cells(Lig, "A"), "dans le pays ", "")
'affectations au dictionary
For Cptr_b = T_pays(Cptr_a, 1) To T_pays(Cptr_a, 2)
Ville = Cells(Cptr_b, "B")
If Ville <> "" Then
If Not D_ville.exists(Ville) Then
D_ville.Add Ville, T_pays(Cptr_a, 3) & " "
Else
D_ville.Item(Ville) = D_ville.Item(Ville) & T_pays(Cptr_a, 3) & " "
'test = D_ville.Item(Ville)
End If
End If
Next
Next
'restitution pays par ville
Range("G2").Resize(D_ville.Count, 1) = Application.Transpose(D_ville.Keys)
Range("H2").Resize(D_ville.Count, 1) = Application.Transpose(D_ville.items)
End Sub
--
