Combinaison à partir d'une chaine de caractère d'une variable tableau

Bonjour à tous

C'est mon premier Job et on m'a demandé d'avancer sur un projet. Je n'aurai jamais pu autant avancer sans les questions/réponse de ce forum alors merci à tous.

J'ai une colonne de tableau dans laquelle se trouve des intitulés de voie simplifiés (nom de la variable : Sect(i)). Il peu y avoir plusieurs centaines de lignes.

i; Sect(i); Secto(i)
1; francois miterand; Etablissement 1
2; acacia; Etablissement 2
3; piere marie curie; Etablissement 1
4; ....;


Un des objectifs du projet est de faire des requêtes dans un autre gros fichier afin de leur affecter les établissements ci-dessus à partir des intitulés de voie.
Pour se faire, il faut d'abord que j'arrive à faire un répertoire de toutes les requêtes a adresser au gros fichier. Je veux avoir l'ensemble des arrangements possibles pour chaque intitulé d'adresse (nom de la variable : Sect(i)) avec une condition : on conserve le mot le plus à droit qui reste à sa place.

Exemple pour piere marie curie:

piere marie curie;
marie piere curie;
marie curie;
piere curie;
curie;

Résultat pour l'ensemble du répertoire :

j; Rep(j); Secto(j)
1; pierre marie curie; Etablissement 2
2; marie pierre curie; Etablissement 2
3; francois miterand; Etablissement 1
4; marie curie; Etablissement 2
5; pierre curie; Etablissement 2
6; curie; Etablissement 2
7; miterand; Etablissement 1
8; acacia; Etablissement 1
...; ...;


Ma plus grosse difficulté est d'empiler les rep(j) alors que je ne connais pas, au départ, la valeur de j. J'arrive à faire ce genre de choses avec les objets range (offset par exemple) mais pas avec des modalités de tableau.

Je pense pas utiliser comme il faut la boucle "for each" mais je ne vois pas comment faire :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Sub repertoire2() Dim sect$(), secto$(), rep$(), nbl1%, nbl2%, i%, j%, c   'Chargment des données sect (colonne s) et secto (colonne v) nbl1 = Range("S1").End(xlDown).Row ReDim sect$(nbl1 - 1), secto$(nbl1 - 1) For i = 1 To UBound(sect) sect(i) = Range("s" & i) secto(i) = Range("v" & i) Next i   'Premières lignes du répertoire (les autres conditions plus tard) For Each c In sect If UBound(Split(c)) = 2 Then rep = sect Next   ' Teste du repertoire (colonne y) nbl2 = UBound(rep) ReDim rep(nbl2) For j = 0 To UBound(rep) rep(j) = Range("y" & j + 1) Next j   End Sub

---

Aucun message d'erreur mais aussi aucun effet ...

Quelqu'un aurait-t-il l'extrême gentillesse de m'aider ?

PS : navré pour la lisibilité des tableaux mais le site n'a pas gardé la mise en forme d'origine

bonjour,
si j'ai bien compris ;)

Sect (3) --> pierre marie curie ... et ... Secto (3) --> Etablissement 1

a) un tablo TMP() récupère tous les éléments de Sect (3)
b) test si plusieurs éléments
c) garder le dernier
d) combiner avec les autres éléments
e) ajouter Secto (3)

pour le (a) ... tout le reste n'est que manip de tablo
TabElement = Split( Sect (3) , " ")

@+JP

J'ai fini par arriver à quelque chose en faisant comme je pouvais avec ce que je savais faire.

Un sub qui charge des données adresse issu d'un repertoire, qui les passe dans une fonction "arrangement", puis qui supprime les espaces vides créés par ma modeste fonction.

La suppression des espaces vides fonctionne avec des lignes de jacques boisgontier que j'ai arrangé pour mon cas. Toute proposition d'amélioration est la bienvenue.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42

Option Explicit Sub repertoire()   Dim sect$(), sect_s$(), nbl_sect&, I&, K&, l&, tab_sect_2() nbl_sect = Range("U1").End(xlDown).Row ReDim sect$(nbl_sect - 1), sect_s(nbl_sect - 1), nbl_sect2(nbl_sect - 1) For I = 1 To UBound(sect_s)   'chargement des données sect_s(I) = Range("U" & I + 1) Next I   'remplissage du repertoire ReDim tab_sect_2(15 * nbl_sect, 7) For I = 1 To UBound(sect_s) For K = 0 To 14 If ARRANGEMENT(sect_s(I), K) <> "" Then tab_sect_2(I + K * UBound(sect_s), 6) = ARRANGEMENT(sect_s(I), K) tab_sect_2(I + K * UBound(sect_s), 7) = UBound(Split(sect_s(I))) End If Next K Next I   'Suppression des lignes vides For l = 1 To UBound(tab_sect_2) Dim n%, j% If tab_sect_2(l, 1) <> "" Then n = n + 1 Next l j = 0 Dim tab_sect_3: ReDim tab_sect_3(1 To n, 0 To UBound(tab_sect_2, 2)) For l = 1 To UBound(tab_sect_2) If tab_sect_2(l, 1) <> "" Then j = j + 1: For K = 1 To UBound(tab_sect_2, 2): tab_sect_3(j, K) = tab_sect_2(l, K): Next K Next l   'Test tableau 3 For l = 1 To UBound(tab_sect_3) Range("W" & l + 1) = tab_sect_3(l, 0) Range("AC" & l + 1) = tab_sect_3(l, 6) Range("AD" & l + 1) = tab_sect_3(l, 7) Next l End Sub

---

Une fonction arrangement qui réalise les arrangements en fonction des contraintes mentionnés ci-dessus. Je n'ai mis que 4 arrangement sur les 15 qui sont dans la fonction originale.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Function ARRANGEMENT(texte$, l&) As String Dim txt%, mot$(), result$ mot() = Split(texte) txt = UBound(mot) ' chaine de caractère de 4 mots à la fin : If l = 0 And txt = 4 - 1 Then result = result & texte '414 'chaine de caractère de 3 mots à la fin : If l = 1 And txt = 4 - 1 Then result = result & mot(0) & " " & mot(1) & " " & mot(3) ' 423 If l = 2 And txt = 4 - 1 Then result = result & mot(0) & " " & mot(2) & " " & mot(3) '433 If l = 14 And txt = 1 - 1 Then result = result & texte '111 ARRANGEMENT = result End Function

---

Maintenant je vais chercher comment faire pour supprimer, dans un array, toutes les lignes qui doublonnent. Par exemple si j'ai deux lignes qui se ressemblent, je vais essayer de supprimer les deux.

Si quelqu'un à un peu d'aide à m'offrir il sera toujours le bienvenue.