Aide sur dictionary

Bonjour

Le problème est que dans ton code tu parles d'une colonne E tout à fait vide...

En admettant qu'il s'agisse en fait de la colonne C
que veux tu dire par:
le but est de remplir la colonne des "1 sur 2" etc., par rapport au pays qui se trouve à côté.

Bonjour,

Merci pour cette réponse.
Le code correspond en fait au fichier réel, dans lequel la colonne E n'est pas vide. J'aurais du l'enlever avant d'uploader le fichier (désolé, c'est un oubli).

---

Donc, sur ce fichier joint, au départ la colonne B est vide (je l'ai remplie à la main pour montrer ce que j'ai besoin), et je souhaiterais, en utilisant un dictionary, la remplir avec les indication "1 sur 2", "2 sur 2" etc, par rapport aux données de la colonne C.

Par exemple :
- Il y a deux FRANCE dans la colonne C, j'aimerais que dans la colonne B apparaisse "1 sur 2", et "2 sur 2" à côté de chaque zone FRANCE.
- Il y a quatre ALLEMAGNE dans la colonne C, j'aimerais que dans la colonne B apparaisse "1 sur 4", et "2 sur 4", "3 sur 4" et "4 sur 4" à côté de chaque zone ALLEMAGNE.

J'ai bien quelques pistes, mais j'ai surtout des lacunes avec les dictionary.

Merci beaucoup !

Nb

Il peut y avoir une vingtaine de pays différents, et pour chaque pays on peut monter jusqu'à trente occurences.

Sans passer par un dictonary ? Je suis preneur de toute façon, tant que c'est bien en VBA (à intégrer dans une macro déjà en place).

Merci beaucoup pour ton aide.

Je suis bien passé par dictionary ( au départ on ne connait pas quel sera l'outil ad hoc)

sur le fichier que tu m'as passé

Option Explicit
Const Col As String * 1 = "C" ' à adapter
'-------
Sub Decompter_par_pays()
Dim Derlig As Long, Idx As Long 'à adapter type svt nbre lignes
Dim T_out()
Dim D_fax As Object, Pays As String, Sur_x As Long '(type sur_x à adapter)

     'initialisations
     Application.ScreenUpdating = False
     Derlig = Columns("C").Find("*", , , , , xlPrevious).Row - 2
      ' mémorisation en mémoire ram du tableau (t_out)
     T_out = Range("B2:C" & Derlig)
     Set D_fax = CreateObject("Scripting.Dictionary")
     
     'affectations des décomptes par pays
     For Idx = 1 To UBound(T_out) Step 4
          Pays = T_out(Idx, 2)
          Sur_x = Application.CountIf(Columns(Col), Pays)
          If Not D_fax.Exists(Pays) Then
               D_fax.Add Pays, 1
               T_out(Idx, 1) = 1 & " sur " & Sur_x
          Else
               D_fax.Item(Pays) = D_fax.Item(Pays) + 1
               T_out(Idx, 1) = D_fax.Item(Pays) & " sur " & Sur_x
          End If
     Next
     
     'restitution
     Range("E2").Resize(UBound(T_out), 2) = T_out ' E2 à adapter pour vérif procédure et à supprimer si OK
     'Range("B2").Resize(UBound(T_out), 2) =  T_out      B2 'à adapter et a activer après vérif OK
End Sub

Michel

Pff, une chose est sûre, c'est que ça fonctionne très bien.
Il ne me reste plus qu'à comprendre comment !

En tout cas un énorme merci pour ton aide.

Je vais essayer de l'adapter au fichier réel, qui comporte beaucoup plus de lignes et de colonnes.
Si j'y arrive, je mettrai le sujet en Résolu, sinon... je te demanderais conseil ?

Merci !

oups.
Premier problème pour mon fichier réel : Le Step 4 de la boucle

For Idx = 1 To UBound(T_out) Step 4

ne peut pas fonctionner, parce qu'il n'y a pas toujours le meme nombre de ligne entre les pays.
Par contre, dans le fichier réel le pays se trouvera toujours deux lignes en dessous de "Zone" (pas une seule ligne comme sur le fichier joint).

Est-ce qu'il y a une astuce ?

Désolé, c'était un peu long de le modifier, ce sont des fichiers privés je ne peux pas les transmettre en l'état.

https://www.cjoint.com/?3Cvmcbxk7n9

J'ai mis en jaune la cellule où doit figurer le 1 sur... (toujours à droite du "P :")
Le pays est toujours à côté de cette cellule, et se trouve en réalité 4 cases sous la cellule ZONE.

Si tu as le temps de regarder, ce serait vraiment gentil.

Merci,

Pourquoi ne pas montrer un extrait du classeur REEL au départ: en voulant simplifier, tu m' obliges en fait à recommencer tout le boulot (et c'est souvent le cas sur les forums)
:-(
Imagjne ce que cela donnerait avec une prestation facturée par un sous-traitant!

VBA, ou autre langage de prog, demande que soit défini précisément et sans ambiguité le contexte du domaine à traiter.

D'autre part, les cellules fusionnées sont à proscrire avec une utilisation de macros (enregistreur ou VBA)

il existe pourtant une technique simple pour centrer sur plusieurs colonnes:
par exemple pour col A:D
selectionner A4:D4
puis après avoir "défusionner" (1), centré sur plusieurs colonnes (2)

donc à toi de jouer pour rendre ton classeur compatible avec du VBA

Michel

Malheureusement, c'est un fichier généré par un système indépendant, que je ne peux pas modifier (et les données sont confidentielles).

Je sais bien que c'est le bazar, j'ai déjà plusieurs macros qui tournent sur ce genre de fichier, elles sont toutes compliquées à cause des cellules fusionnées, des cellules vides etc.
C'est pour ça que j'ai autant de mal à m'en sortir. :o(

Par contre, ton code devrait très bien fonctionner, une fois adapté. Il ne resterait plus qu'à repérer le pays qui se trouve toujours sous ZONE, je pense.
Est-ce que c'est possible ?

Sinon j'essayerais de trouver autre chose... (j'avais déjà essayé avec plusieurs boucles : à chaque fois que je trouve Zone je créé une clef avec le pays dessous, mais... j'ai un peu de mal).

Si tu n'as pas le temps ne t'en fais pas, je trouverais bien quelque chose.

:o/

Maintenant, ce que je peux faire, c'est selectionner les 4 colonnes de A à D, et lancer ce code :

With Selection
.MergeCells = False
.HorizontalAlignment = xlCenterAcrossSelection
End With

Il n'y aura plus de cellule fusionnée, et le fichier gardera la même mise en forme.
Mais est-ce que ce sera utile ?

ET voilà regarde si OK. Bien vu pour les cellules fusionnées(ouf!)

Option Explicit
'-------
Sub Decompter_par_pays()
Dim Derlig As Integer, Idx As Integer  'nbre lignes estimées à 30000
Dim T_pays(), T_nbre()
Dim D_fax As Object, Pays As String, Sur_x As Byte '

'--------initialisations
     Application.ScreenUpdating = False
     'effacement cellule fusionnées
     With Columns("A:D")
          .MergeCells = False
          .HorizontalAlignment = xlCenterAcrossSelection
     End With
     ' mémorisation en mémoire ram des tableaux (T_pays,T_nbre)
     Derlig = Columns("C").Find("ZONE", , , , , xlPrevious).Row + 4
      T_pays = Application.Transpose(Range("C5:C" & Derlig))
     T_nbre = Application.Transpose(Range("B5:B" & Derlig))
     'instantation dictionary
     Set D_fax = CreateObject("Scripting.Dictionary")
     
'-------------affectations des décomptes par pays
     For Idx = 1 To UBound(T_pays)
          If T_pays(Idx) = "ZONE" Then
               Idx = Idx + 4
               Pays = T_pays(Idx)
               Sur_x = Application.CountIf(Columns("C"), Pays)
               If Not D_fax.Exists(Pays) Then
                    D_fax.Add Pays, 1
               Else
                    D_fax.Item(Pays) = D_fax.Item(Pays) + 1
               End If
                T_nbre(Idx) = D_fax.Item(Pays) & " sur " & Sur_x
          End If
     Next
     
'--------'restitution
     Range("E5").Resize(UBound(T_nbre), 1) = Application.Transpose(T_nbre) 'remplacer E5 par B5 après essais
End Sub

Michel

Bonjour Michel,

C'est impressionnant.
J'ai fait quelques tests à la maison, ça a l'air parfait.
Je ferais d'autres tests en live au bureau mercredi prochain, mais à priori aucune raison pour que ça ne fonctionne pas.

Un énorme, énorme merci pour ton aide précieuse, ta disponibilité, ton travail, c'est très, très gentil.

De mon côté, je vois que j'ai beaucoup de progrès à faire. Je pensais connaitre le Vba mais je me rends compte que je débute seulement (à ma décharge, j'apprends tout seul quand j'ai un peu de temps... mais je vais essayer de comprendre tout ton code, ça va m'aider).

Si tu dispenses des cours, par mail ou tuto (sait-on jamais) je suis intéressé.

Merci encore.

A mercredi pour le sujet en résolu.

Nb

Bonjour,

J'ai donc fait plusieurs tests qui sont tous positifs, j'ai même adapté cette macro à d'autres utilisations. Parfait.

Il me reste une dernière question mais c'est vraiment pour le luxe :

Est-ce qu'il possible d'ajouter une condition couleur ? Quelque chose comme :
If T_pays(Idx) = "ZONE" And T_Pays(Idx).Interior.ColorIndex = xlnone Then
Pour que ne soient pris en compte dans la numérotation QUE les cellules Zone qui ne sont pas en couleur ? S'il y a trois pays Allemagne, mais qu'une cellule Zone sur les trois est en couleur, alors il n'en comptera que deux et numérotera les Zone 1 / 2 et 2 / 2, sans rien mettre pour celui qui est en couleur.
Si c'est compliqué ce n'est pas grave.

Un tout grand merci.

Nb

Désolé d'être si lent entre les réponses, je suis au bureau, donc assez occupé :o(

Effectivement, c'est bien ce que je cherchais, mais... il reste un souci : Le
Sur_x = Application.CountIf(Columns("C"), Pays)
est maintenant faux, puisqu'il devrait être diminué de 1 à chaque fois qu'une numérotation n'est pas prise en compte.

Je vais finir par te poser une colle :o)

Je répondrais probablement dans la soirée ou demain.

Merci par avance.

Pas de problème Michel, c'est déjà énorme, tout ce que tu as fait.

Je suis conscient que mes demandes étaient nombreuses, compliquées, qu'elles changeaient en cours de route, ce n'était pas volontaire, je suis désolé.

Je me contenterais bien largement de ce que tu as fait, je t'en suis vraiment très reconnaissant.
Merci également pour les liens, que je vais étudier, et qui peut-être un jour me permettront d'aider les autres bénévolement.

Un très très grand merci pour ton aide et pour ta gentillesse !

Nabhalia