Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Macro pour Recherche et Déplacement de cellules (Création d'une BDD à partir de fiches)...

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

22 réponses
Avatar
gorwel2
Bonsoir les experts,

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

La difficult=E9 vient du fait que les fiches ne sont pas forc=E9ment compl=
=E8tes (il peut manquer la ligne t=E9l ou le fax) et le champs activit=E9 p=
eut prendre 2 lignes ou + (voire absente)... En revanche, les fiches sont s=
yst=E9matiquement s=E9par=E9e par l'item "Plus d'informations [+]" (3 ligne=
s vierges avant et 1 apr=E8s). Aussi, le nom appara=EEt 2 fois.

A vos talents, cordialement, Go2.

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

*EX :=20
Je voudrais les donn=E9es sous cette forme... :
A B C D=20
1 Nom Activit=E9 T=E9l 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.
=09
... et voici la longue liste telle qu'elle se pr=E9sente actuellement : =
=09

A B =09
6 nom 1 A =09
7 nom 1 A =09
8 T=E9l. 01 01 01 01 01 =09
9 Fax 01 01 01 01 02 =09
10 E.mail A@GMAIL.COM =09
11 =09
12 (Activit=E9 1 :)Nautisme =09
13 =09
14 =09
15 =09
16 Plus d'informations [+] =09
17 =09
18 nom 2 B =09
19 nom 2 B =09
20 T=E9l. 02 02 02 02 02 =09
21 Fax 02 02 02 02 03 =09
22 E.mail B@GMAIL.COM =09
23 =09
24 Activit=E9 2 =09
25 Activit=E9 2
...
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
gorwel2
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



Non désolé, ça marche pas : il me signale une erreur de syntaxe en me surlignant cette ligne :
Nbrfiche = Application.CountIf(Sheets("test").Range("A:A"), "Plus d'infor mations

Cdlt, Go2
Avatar
isabelle
il s'est créé un retour à la ligne intempestif lors du copier/coller de la macro
dans le message

http://www.cjoint.com/c/EFCpwawU4xa

isabelle

Le 2015-06-28 09:30, a écrit :

Non désolé, ça marche pas : il me signale une erreur de syntaxe en me surlignant cette ligne :
Nbrfiche = Application.CountIf(Sheets("test").Range("A:A"), "Plus d'informations

Cdlt, Go2

Avatar
gorwel2
On se rapproche... mais il y a deux petits hic dans la présentation des r ésultats de l'onglet liste :

1) le nom du contact apparaît 2 fois (au lieu d'une) en colonne A.
2) l'activité apparaît elle aussi en colonne A (au lieu de B).

Cela vient peut-être de ma 1ère version du fichier qui était mal form atée. Je remets ici la bonne version : https://drive.google.com/file/d/0B 3XGolv6S_fRTTVEdVZ2NEU4S2c/view?usp=sharing

Une petite blague en remerciement : "Avec quoi on ramasse la papaye ?...

...

... Avec une foufourche ! ;-)) Bon courage et encore merci, cdlt, Go2.


Le dimanche 28 juin 2015 17:23:19 UTC+2, isabelle a écrit :
il s'est créé un retour à la ligne intempestif lors du copier/colle r de la macro
dans le message

http://www.cjoint.com/c/EFCpwawU4xa

isabelle

Le 2015-06-28 09:30, a écrit :

> Non désolé, ça marche pas : il me signale une erreur de syntaxe e n me surlignant cette ligne :
> Nbrfiche = Application.CountIf(Sheets("test").Range("A:A"), "Plus d'i nformations
>
> Cdlt, Go2
>
Avatar
isabelle
Salut Go2,

j’espère que tu pourras comprendre ce code pour l’adapter si la source est modifier,
ps/ Attention au retour à la ligne intempestif lors du copier/coller

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 = 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 "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
If Not IsError(Application.Search("Activité", Sheets("test").Cells(i,
1))) Then
Sheets("liste").Cells(n, 2) = Sheets("liste").Cells(n, 2) & " " &
Sheets("test").Cells(i, 1)
Else
Sheets("liste").Cells(n, 1) = Sheets("liste").Cells(n, 1) & " " &
Sheets("test").Cells(i, 1)
End If
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

Le 2015-06-28 12:33, a écrit :
On se rapproche... mais il y a deux petits hic dans la présentation des résultats de l'onglet liste :

1) le nom du contact apparaît 2 fois (au lieu d'une) en colonne A.
2) l'activité apparaît elle aussi en colonne A (au lieu de B).

Cela vient peut-être de ma 1ère version du fichier qui était mal formatée. Je remets ici la bonne version :


https://drive.google.com/file/d/0B3XGolv6S_fRTTVEdVZ2NEU4S2c/view?usp=sharing

Une petite blague en remerciement : "Avec quoi on ramasse la papaye ?...
Avatar
gorwel2
Ok, merci. Je testé ce soir ou demain, et te dis.
Cdlt, Go2.
Avatar
gorwel2
Bonjour,

J'ai testé et après avoir -fastidieusement- supprimer les sauts de lign e comme tu le précisais, ça a bien corrigé l'activité en colonne B. .. En revanche, le nom apparaît toujours 2 fois en colonne A (dans l'ongl et "Liste").
Voyons, je me suis peut-être mal exprimé : sur chaque fiche apparaît 2 fois le même nom, mais je n'ai besoin dans l'onglet liste que de l'UN d es deux (puisque qu'ils sont systématiquement identiques). Le doublon est gênant car il ne me permet pas de faire un publipostage par la suite...

Pour les modifications ou personnalisations que je pourrais y apporter, j'a voue qu'à la lecture de ton code, ça me dépasse de beaucoup ! J'essay e bien de comprendre, je reconnais certaines structures, mais je serais bie n incapable de le modifier ! Pour moi, ça tient de la sorcellerie ;-))

Cordialement, Go2.


Le lundi 29 juin 2015 05:54:57 UTC+2, isabelle a écrit :
Salut Go2,

j'espère que tu pourras comprendre ce code pour l'adapter si la source est modifier,
ps/ Attention au retour à la ligne intempestif lors du copier/coller

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 = 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 "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
If Not IsError(Application.Search("Activité", Sheets("test"). Cells(i,
1))) Then
Sheets("liste").Cells(n, 2) = Sheets("liste").Cells(n, 2) & " " &
Sheets("test").Cells(i, 1)
Else
Sheets("liste").Cells(n, 1) = Sheets("liste").Cells(n, 1) & " " &
Sheets("test").Cells(i, 1)
End If
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

Le 2015-06-28 12:33, a écrit :
> On se rapproche... mais il y a deux petits hic dans la présentation d es résultats de l'onglet liste :
>
> 1) le nom du contact apparaît 2 fois (au lieu d'une) en colonne A.
> 2) l'activité apparaît elle aussi en colonne A (au lieu de B).
>
> Cela vient peut-être de ma 1ère version du fichier qui était mal formatée. Je remets ici la bonne version :
https://drive.google.com/file/d/0B3XGolv6S_fRTTVEdVZ2NEU4S2c/view?usp=s haring
>
> Une petite blague en remerciement : "Avec quoi on ramasse la papaye ?.. .
Avatar
JièL
Le 30/06/2015 15:48, a écrit :
Pour moi, ça tient de la sorcellerie



Tiens ? Isabelle de la Geôlière est passée du status d'"ange" à celui de
"sorcière" ?! ;-))))

--
JièL en jeu ou des monts
Avatar
sivilt
Le mardi 30 juin 2015 15:59:54 UTC+2, JièL a écrit :
Le 30/06/2015 15:48, a écrit :
> Pour moi, ça tient de la sorcellerie

Tiens ? Isabelle de la Geôlière est passée du status d'"ange" à c elui de
"sorcière" ?! ;-))))

--
JièL en jeu ou des monts



Une bien aimable sorcière quand même.

Cdlt, Go2.
Avatar
Jacquouille
Nous avons bien une demi-ange et demi-démon ...... soit la bien nommée
Misange ...mi démon

Quant à la Géolière, depuis qu'on lui a transféré sa case IV65536 plus vers
l'Est et plus vers le Sud .... elle passe sa vie dans l'ascenseur.

Comme quoi, tout fout le camps, mon bon Monsieur.

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"JièL" a écrit dans le message de groupe de discussion :
mmu7cm$r4$

Le 30/06/2015 15:48, a écrit :
Pour moi, ça tient de la sorcellerie



Tiens ? Isabelle de la Geôlière est passée du status d'"ange" à celui de
"sorcière" ?! ;-))))

--
JièL en jeu ou des monts


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Avatar
isabelle
ah ah! les souris dansent et j'arrive après la fête,
haut les mains et tous dans l'ascenseur, nous allons faire un tour en XFD1048576 ;-0

ps/ Géo voici une nouvelle version avec un seul nom et plein d'explication
http://www.cjoint.com/c/EGcbWrXShPa
isabelle


Le 2015-06-30 14:17, Jacquouille a écrit :
Nous avons bien une demi-ange et demi-démon ...... soit la bien nommée Misange
...mi démon

Quant à la Géolière, depuis qu'on lui a transféré sa case IV65536 plus vers
l'Est et plus vers le Sud .... elle passe sa vie dans l'ascenseur.

Comme quoi, tout fout le camps, mon bon Monsieur.

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"JièL" a écrit dans le message de groupe de discussion :
mmu7cm$r4$

Le 30/06/2015 15:48, a écrit :
Pour moi, ça tient de la sorcellerie



Tiens ? Isabelle de la Geôlière est passée du status d'"ange" à celui de
"sorcière" ?! ;-))))

1 2 3