Discussion :

[SectoSSD]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mjpmjp]

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

[SectoSSD]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.