Macro pour Recherche et Déplacement de cellules (Création d'une BDD à partir de fiches)...

Le
gorwel2
Bonsoir les experts,

Je cherche à rechercher/déplacer automatiquement de nombreuses cellules=
pour les avoir sous formes de données en colonnes. Comme je l'ai vu à =
cette adresse (http://boisgontierjacques.free.fr/pages_site/cellules.htm), =
à la rubrique "Création d'une BD à partir de fiches", j'ai vu que ç=
a avait l'air faisable mais je n'arrive pas à bien l'appliquer à mon ta=
bleau (voir ci-dessous*).

La difficulté vient du fait que les fiches ne sont pas forcément compl=
ètes (il peut manquer la ligne tél ou le fax) et le champs activité p=
eut prendre 2 lignes ou + (voire absente) En revanche, les fiches sont s=
ystématiquement séparée par l'item "Plus d'informations [+]" (3 ligne=
s vierges avant et 1 après). Aussi, le nom apparaît 2 fois.

A vos talents, cordialement, Go2.

PS : je joins un exemplaire du fichier à cette adresse : https://drive.go=
ogle.com/file/d/0B3XGolv6S_fRellPRjVOME03Z1k/view?usp=sharing

*EX :
Je voudrais les données sous cette forme :
A B C D
1 Nom Activité Tél Courriel
2 nom 1 Nautisme 01 01 01 01 01 A@GMAIL.COM
3 nom 2 Autres 02 02 02 02 02 B@gmail.com
etc.

et voici la longue liste telle qu'elle se présente actuellement : =


A B
6 nom 1 A
7 nom 1 A
8 Tél. 01 01 01 01 01
9 Fax 01 01 01 01 02
10 E.mail A@GMAIL.COM
11
12 (Activité 1 :)Nautisme
13
14
15
16 Plus d'informations [+]
17
18 nom 2 B
19 nom 2 B
20 Tél. 02 02 02 02 02
21 Fax 02 02 02 02 03
22 E.mail B@GMAIL.COM
23
24 Activité 2
25 Activité 2
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 3
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
isabelle
Le #26358119
bonjour,

est ce qu'il y a toujours la valeur "Plus d'informations [+] " qui sépare les
fiches ?

isabelle

Le 2015-06-25 17:22, a écrit :
Bonsoir les experts,

Je cherche à rechercher/déplacer automatiquement de nombreuses cellules pour les avoir sous formes de données en colonnes.
Comme je l'ai vu à cette adresse (http://boisgontierjacques.free.fr/pages_site/cellules.htm), à la rubrique "Création d'une BD à partir de fiches",
j'ai vu que ça avait l'air faisable mais je n'arrive pas à bien l'appliquer à mon tableau (voir ci-dessous*).

La difficulté vient du fait que les fiches ne sont pas forcément complètes (il peut manquer la ligne tél ou le fax) et le champs activité
peut prendre 2 lignes ou + (voire absente)... En revanche, les fiches sont systématiquement séparée >
par l'item "Plus d'informations [+]" (3 lignes vierges avant et 1 après). Aussi, le nom apparaît 2 fois.

A vos talents, cordialement, Go2.

PS : je joins un exemplaire du fichier à cette adresse : https://drive.google.com/file/d/0B3XGolv6S_fRellPRjVOME03Z1k/view?usp=sharing

*EX :
Je voudrais les données sous cette forme... :
A B C D
1 Nom Activité Tél Courriel
2 nom 1 Nautisme 01 01 01 01 01
3 nom 2 Autres 02 02 02 02 02
etc.

... et voici la longue liste telle qu'elle se présente actuellement :

A B
6 nom 1 A
7 nom 1 A
8 Tél. 01 01 01 01 01
9 Fax 01 01 01 01 02
10 E.mail
11
12 (Activité 1 :)Nautisme
13
14
15
16 Plus d'informations [+]
17
18 nom 2 B
19 nom 2 B
20 Tél. 02 02 02 02 02
21 Fax 02 02 02 02 03
22 E.mail
23
24 Activité 2
25 Activité 2
...

isabelle
Le #26358124
svp oublier ma précédente question au sujet de "Plus d'informations [+]"

Aussi, le nom apparaît 2 fois.



lequel des 2 nom doit on retenir ? ou doit on retenir les 2 noms dans la même
cellule ?

le champs activité peut prendre 2 lignes ou + (voire absente)



doit on mettre ces informations (activité) dans la même cellule ?

isabelle
sivilt
Le #26358180
Bonjour et merci de votre attention.

Pour répondre à la question sur les 2 noms, seul un des deux noms est à retenir, le premier par exemple.

Concernant les lignes d'activité l'idéal serait de les avoir concatén ées effectivement en une seule cellule, mais je peux m'en passer ce n'est pas une information primordiale : la première ligne peut suffire. (Pour info, il arrive que cette information s'étale sur trois ou quatre lignes parfois...)

Pour l'item "+ Plus d'information [+]", je confirme, il apparaît toujours à la fin de chaque fiche avec trois lignes vides au-dessus et une en des sous.

En espérant avoir été assez clair, cordialement, Go2.
isabelle
Le #26358215
bonjour Go2,

voici un début de piste, j'ai ajouté l'onglet "liste" pour mettre le résultat.
http://www.cjoint.com/c/EFAqBQGtWNa

Sub Macro1()
Dim LastRow As Long, n As Integer, i As Integer
Dim Nbrfiche As Integer, ficheDébut As Integer, ficheFin As Integer

With Sheets("liste")
.Range("A2:D" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
End With

LastRow = Sheets("test").Cells(Sheets("test").Rows.Count, 1).End(xlUp).Row
Nbrfiche = Application.CountA("Plus d'informations [+]",
Sheets("test").Range("A:A"))
ficheDébut = 2
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A:A"), 0)

For n = 2 To Nbrfiche + 1
For i = ficheDébut To ficheFin
Select Case Sheets("test").Cells(i, 1)
Case "Nom":
Sheets("liste").Cells(n, 1) = Sheets("liste").Cells(n, 1) & " " &
Sheets("test").Cells(i, 2)
Case "Activité":
Sheets("liste").Cells(n, 2) = Sheets("liste").Cells(n, 2) & " " &
Sheets("test").Cells(i, 2)
Case "Tél.":
Sheets("liste").Cells(n, 3) = Sheets("liste").Cells(n, 3) & " " &
Sheets("test").Cells(i, 2)
Case "E.mail":
Sheets("liste").Cells(n, 4) = Sheets("liste").Cells(n, 4) & " " &
Sheets("test").Cells(i, 2)
End Select
Next
ficheDébut = ficheFin + 1
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A" & ficheDébut & ":A" & LastRow), 0) + ficheDébut - 2
Next
End Sub

isabelle
gorwel2
Le #26358263
Merci beaucoup, Isabelle. Je pars tester ta solution et revient te dire si ça fonctionne.

Cordialement, Go2.


Le vendredi 26 juin 2015 18:28:21 UTC+2, isabelle a écrit :
bonjour Go2,

voici un début de piste, j'ai ajouté l'onglet "liste" pour mettre le résultat.
http://www.cjoint.com/c/EFAqBQGtWNa

Sub Macro1()
Dim LastRow As Long, n As Integer, i As Integer
Dim Nbrfiche As Integer, ficheDébut As Integer, ficheFin As Integer

With Sheets("liste")
.Range("A2:D" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
End With

LastRow = Sheets("test").Cells(Sheets("test").Rows.Count, 1).End(xlUp). Row
Nbrfiche = Application.CountA("Plus d'informations [+]",
Sheets("test").Range("A:A"))
ficheDébut = 2
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A:A"), 0)

For n = 2 To Nbrfiche + 1
For i = ficheDébut To ficheFin
Select Case Sheets("test").Cells(i, 1)
Case "Nom":
Sheets("liste").Cells(n, 1) = Sheets("liste").Cells(n, 1) & " " &
Sheets("test").Cells(i, 2)
Case "Activité":
Sheets("liste").Cells(n, 2) = Sheets("liste").Cells(n, 2) & " " &
Sheets("test").Cells(i, 2)
Case "Tél.":
Sheets("liste").Cells(n, 3) = Sheets("liste").Cells(n, 3) & " " &
Sheets("test").Cells(i, 2)
Case "E.mail":
Sheets("liste").Cells(n, 4) = Sheets("liste").Cells(n, 4) & " " &
Sheets("test").Cells(i, 2)
End Select
Next
ficheDébut = ficheFin + 1
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A" & ficheDébut & ":A" & LastRow), 0) + ficheDé but - 2
Next
End Sub

isabelle
sivilt
Le #26358269
Le vendredi 26 juin 2015 18:28:21 UTC+2, isabelle a écrit :
bonjour Go2,

voici un début de piste, j'ai ajouté l'onglet "liste" pour mettre le résultat.
http://www.cjoint.com/c/EFAqBQGtWNa

Sub Macro1()
Dim LastRow As Long, n As Integer, i As Integer
Dim Nbrfiche As Integer, ficheDébut As Integer, ficheFin As Integer

With Sheets("liste")
.Range("A2:D" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
End With

LastRow = Sheets("test").Cells(Sheets("test").Rows.Count, 1).End(xlUp). Row
Nbrfiche = Application.CountA("Plus d'informations [+]",
Sheets("test").Range("A:A"))
ficheDébut = 2
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A:A"), 0)

For n = 2 To Nbrfiche + 1
For i = ficheDébut To ficheFin
Select Case Sheets("test").Cells(i, 1)
Case "Nom":
Sheets("liste").Cells(n, 1) = Sheets("liste").Cells(n, 1) & " " &
Sheets("test").Cells(i, 2)
Case "Activité":
Sheets("liste").Cells(n, 2) = Sheets("liste").Cells(n, 2) & " " &
Sheets("test").Cells(i, 2)
Case "Tél.":
Sheets("liste").Cells(n, 3) = Sheets("liste").Cells(n, 3) & " " &
Sheets("test").Cells(i, 2)
Case "E.mail":
Sheets("liste").Cells(n, 4) = Sheets("liste").Cells(n, 4) & " " &
Sheets("test").Cells(i, 2)
End Select
Next
ficheDébut = ficheFin + 1
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A" & ficheDébut & ":A" & LastRow), 0) + ficheDé but - 2
Next
End Sub

isabelle



AAAAargh ! J'avais mal formaté mes fiches : le champs "Nom" en fait n'exi ste pas, les noms apparaissent directement en colonne A (rien dans la colon ne B).
Sinon, sur le principe de la macro avec l'onglet liste, ça m'a l'air tout bon. Je remets une version corrigée ici (je n'arrive pas à modifier la macro pour faire apparaître les noms) : https://drive.google.com/file/d/ 0B3XGolv6S_fRWlZHZVdZamNHM3M/view?usp=sharing
Si tu pouvais y jeter un dernier oeil...

Cdlt, Go2.
isabelle
Le #26358276
si j'ai bien compris, les informations sont:
Activité
Liste :
Tél.
Fax
E.mail
Plus d'informations [+]

les autres sont les noms

est ce bien cela ?
isabelle

Le 2015-06-26 18:44, a écrit :

AAAAargh ! J'avais mal formaté mes fiches : le champs "Nom" en fait n'existe pas,
les noms apparaissent directement en colonne A (rien dans la colonne B).
Sinon, sur le principe de la macro avec l'onglet liste, ça m'a l'air tout bon.
Je remets une version corrigée ici (je n'arrive pas à modifier la macro pour faire apparaître les noms) :
https://drive.google.com/file/d/0B3XGolv6S_fRWlZHZVdZamNHM3M/view?usp=sharing
Si tu pouvais y jeter un dernier oeil...

Cdlt, Go2.

gorwel2
Le #26358277
Euh... Pas sûr de m'être bien expliqué. L'item "Liste :" que tu cites n'apparaît pas par exemple (je l'avais juste rajouté pour séparer du haut (ligne 1 et 2 où j'avais commencé un embryon de tableau formaté à mon goût, mais je préfère bien sûr ta solution dans l'autre on glet "Liste")... Si tu préfères, on peut supprimer les lignes 1 à 5).
Les informations commencent donc à partir de la ligne 6 (de l'onglet "Tes t" donc) comme une longue suite de fiches constituées comme ça :

1 Nom1
2 Nom1
3 Tél. 01 01 01 01 01
4 Fax 01 01 01 01 02
5 E.mail
6
7 Activité
8 Activité (suite)
9 Activité (suite)
10
11
12
13 Plus d'informations [+]
14
15 Nom2
16 Nom2
etc.

Et le but est bien de les avoir sous cette forme (dans un autre onglet "Lis te" ok) :

A B C D
1 Nom Activité Tél Courriel
2 Nom 1 Nautisme 01 01 01 01 01
3 Nom 2 Kayak... 02 02 02 02 02
etc.

C'est plus clair ?

Cdlt, Go2.



Le samedi 27 juin 2015 04:02:32 UTC+2, isabelle a écrit :
si j'ai bien compris, les informations sont:
Activité
Liste :
Tél.
Fax
E.mail
Plus d'informations [+]

les autres sont les noms

est ce bien cela ?
isabelle

Le 2015-06-26 18:44, a écrit :

> AAAAargh ! J'avais mal formaté mes fiches : le champs "Nom" en fait n 'existe pas,
> les noms apparaissent directement en colonne A (rien dans la colonne B ).
> Sinon, sur le principe de la macro avec l'onglet liste, ça m'a l'air tout bon.
> Je remets une version corrigée ici (je n'arrive pas à modifier la m acro pour faire apparaître les noms) :
> https://drive.google.com/file/d/0B3XGolv6S_fRWlZHZVdZamNHM3M/view?usp =sharing
> Si tu pouvais y jeter un dernier oeil...
>
> Cdlt, Go2.
>
isabelle
Le #26358349
dit moi si c'est mieux ?

Sub Macro1()
Dim LastRow As Long, n As Integer, i As Integer
Dim Nbrfiche As Integer, ficheDébut As Integer, ficheFin As Integer

With Sheets("liste")
.Range("A2:D" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
End With

LastRow = Sheets("test").Cells(Sheets("test").Rows.Count, 1).End(xlUp).Row
Nbrfiche = Application.CountIf(Sheets("test").Range("A:A"), "Plus d'informations
[+]")
ficheDébut = 1
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A:A"), 0)

For n = 2 To Nbrfiche + 1
For i = ficheDébut To ficheFin
Select Case Sheets("test").Cells(i, 1)
Case "Activité"
Sheets("liste").Cells(n, 2) = Sheets("liste").Cells(n, 2) & " " &
Sheets("test").Cells(i, 2)
Case "Tél."
Sheets("liste").Cells(n, 3) = Sheets("liste").Cells(n, 3) & " " &
Sheets("test").Cells(i, 2)
Case "E.mail"
Sheets("liste").Cells(n, 4) = Sheets("liste").Cells(n, 4) & " " &
Sheets("test").Cells(i, 2)
Case "Fax"
Case "Plus d'informations [+]"
Case Else
Sheets("liste").Cells(n, 1) = Sheets("liste").Cells(n, 1) & " " &
Sheets("test").Cells(i, 1)
End Select
Next
ficheDébut = ficheFin + 1
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A" & ficheDébut & ":A" & LastRow), 0) + ficheDébut - 1
Next
End Sub

isabelle
gorwel2
Le #26358534
Bonjour,

Je vais tester ça ta nouvelle macro et reviens te dire. Encore merci.

Cdlt, Go2.

Le samedi 27 juin 2015 14:38:17 UTC+2, isabelle a écrit :
dit moi si c'est mieux ?

Sub Macro1()
Dim LastRow As Long, n As Integer, i As Integer
Dim Nbrfiche As Integer, ficheDébut As Integer, ficheFin As Integer

With Sheets("liste")
.Range("A2:D" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
End With

LastRow = Sheets("test").Cells(Sheets("test").Rows.Count, 1).End(xlUp). Row
Nbrfiche = Application.CountIf(Sheets("test").Range("A:A"), "Plus d'inf ormations
[+]")
ficheDébut = 1
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A:A"), 0)

For n = 2 To Nbrfiche + 1
For i = ficheDébut To ficheFin
Select Case Sheets("test").Cells(i, 1)
Case "Activité"
Sheets("liste").Cells(n, 2) = Sheets("liste").Cells(n, 2) & " " &
Sheets("test").Cells(i, 2)
Case "Tél."
Sheets("liste").Cells(n, 3) = Sheets("liste").Cells(n, 3) & " " &
Sheets("test").Cells(i, 2)
Case "E.mail"
Sheets("liste").Cells(n, 4) = Sheets("liste").Cells(n, 4) & " " &
Sheets("test").Cells(i, 2)
Case "Fax"
Case "Plus d'informations [+]"
Case Else
Sheets("liste").Cells(n, 1) = Sheets("liste").Cells(n, 1) & " " &
Sheets("test").Cells(i, 1)
End Select
Next
ficheDébut = ficheFin + 1
ficheFin = Application.Match("Plus d'informations [+]",
Sheets("test").Range("A" & ficheDébut & ":A" & LastRow), 0) + ficheDé but - 1
Next
End Sub

isabelle
Publicité
Poster une réponse
Anonyme