Menu

Extraire une liste à partir d'un copier-coller de site [Résolu]

Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
- - Dernière réponse : Guy_L
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
- 20 janv. 2019 à 17:27
Bonjour, Bonjour,
Le site du Bon Coin ne permet pas d'extraire la liste de ses annonces vers Excel, il faut procéder avec un copier-coller et après faire du "nettoyage".
Après avoir enlevé les photos, il reste une liste mais elle n'est pas homogène, elle se présente sous la forme suivante:

[Objet mis en vente]
€5
Téléphonie
Date
13/01/2019 16:05
59 jours restants
6

0

Correspondant respectivement à

Objet
Prix (s'il y en a un)
Catégorie
Titre "Date"
La date et l'heure de dépôt sur le site
Le nbre de jours restant avant expiration de l'annonce
Le nombre de visiteurs
Le nombre de clics pour appel téléphonique
Le nombre de mails

Mais parfois, comme il n'y a pas de prix, la ligne est manquante

Or j'aimerai extraire ces infos sous la forme d'un tableau avec les colonnes suivantes
Intitulé / Prix / Catégorie / Date / vues / tel / mails reçus

Le fait que la longueur de la liste varie avec le nombre d'annonces et qu'il y a parfois un "trou" à l'emplacement prix me pose des problèmes pour réaliser une macro permettant de réaliser cette opération automatiquement. Pouvez-vous m'y aider ?
Merci


Configuration: Windows / Firefox 64.0
Afficher la suite 

Votre réponse

20/28 réponses

Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
Bonjour,

Essayez ceci
https://mon-partage.fr/f/leivjRPU/

Cdlt
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
Déjà un grand merci Frenchie.
malheureusement, il y a un - petit - os:
Il a fallut que je modifie la macro cas il n'y a pas d'intervalle entre les annonces (ou plutôt si, mais je les ai supprimé avec la commande qui va bien, car ces intervalles sont de nombre de lignes variables).
en clair: quand il y a un prix indiqué, le cycle est de neuf lignes (au lieu de 10) et quand ce prix est absent, il n'y en a que 8.
L'ennui c'est qu'au test "If Left(ShVert.Cells(LigV + 1, "A"), 1) = "€" Then", le signe € n'est pas détecté, car ce n'est pas du texte, mais un format "personnalisé" qui disparait si on fait un copier-coller des valeurs.
L'idée était vraiment bonne, mais il faudrait trouver le moyen de:
1) copier les cellules "prix" en leur adjoignant un vrai signe €
2) mettre le test en place sur les cellules copiées
Un moyen serait peut-être de teste ces cellules en vérifiant qu'il s'agit d'un chiffre. En effet, si cette ligne n'existe pas (pas de prix indiqué), il "saute" à la ligne catégorie qui elle, est exclusivement en lettres.
Le test pourrait donc être du type "si le caractère de droite est un chiffre alors ..."
A part cela, je crois que tu as misé juste
Merci d'avance
GL
Commenter la réponse de Guy_L
Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
Bonsoir,

Nouvelle version , on ne détecte plus la présence du prix mais la position de "Date".
Pour l'affichage en Euros, à la fin de l'exécution du programme, on force la colonne prix au format monétaire.
https://mon-partage.fr/f/aG8lPveZ/

Cela va -t-il mieux?
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
Bonjour,
Oui, nettement mieux, mais il reste encore des "bugs":

1) Le résultat du copier-coller depuis le site de vente met les dates automatiquement à l'année courante, de sorte qu'il y a des dates comme 29/12/2019, qui, bien sûr est erronée. J'ai voulu y remédier en mettant "mm/dd" dans les lignes de macro concernées, mais le format obtenu est tout de même jour/mois/année, avec évidemment 2019.

2) après le copier-coller du site, il reste des liens hypertext qui ressurgissent ensuite de manière impromptue dans le fichier obtenu (même la ligne de titres de ShHoriz est curieusement affectée !)

3) Ne voulant pas griller les étapes, je n'ai pas dit que j'utilise deux comptes sur ce site de vente. De fait, je rapatrie 2 copier-coller qui sont mis dans deux feuilles du fichier. Une première étape consiste à enlever les photos, supprimer les lignes vides et colorier en bleu les annonces du compte 1 et laisser en noir celles du compte 2 (vous verrez tout cela dans le script joint). Tout ça marche bien.

Là où ça se complique, c'est qu'avant d'appliquer votre macro "Réorganiser" il me faut copier les annonces du compte 1 et les coller dans la feuille ShVert, puis, à leur suite, mettre celles du compte 2 de façon à n'obtenir qu'une seule liste qui va ensuite "subir" le traitement de votre macro "Réorganiser".
C'est le but de la macro "Compilation" mais cette étape bugue à la ligne :
DerLig1 = Compte1.[A100000].End(xlUp).Row

Et je ne comprends pas pourquoi

Il y a une suite, car une fois la feuille ShHoriz terminée, j'ai créé une suite de macros destinées à en faire une copie datée (onglet daté) et classée en fin de classeur. Je pense que cette partie fonctionne, mais je vérifierai lorsque le reste sera OK

Question: comment puis-je vous envoyer un fichier ? en attendant de le savoir, voici déjà le code:

Sub Traitement_Compte1()
Sheets("Compte1").Select
Dim DerLigne As Long, ligne As Long
'Effacement des photos
Dim img As Object
For Each img In Sheets("Compte1").Shapes
img.Delete
Next
'suppression des lignes vides
Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Alignement à gauche
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'ajustement colonne
Columns("A:A").Select
Selection.Columns.AutoFit
'mise en bleu des lignes Compte1
With Selection.Font
.Color = -65536
.TintAndShade = 0
End With
End Sub
Sub Traitement_Compte2()
Sheets("Compte2").Select
'Effacement des photos
Dim img As Object
For Each img In Sheets("Compte2").Shapes
img.Delete
Next
'suppression des lignes vides
Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Alignement à gauche
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'ajustement colonne
Columns("A:A").Select
Selection.Columns.AutoFit
End Sub
Sub Compilation()
Dim ShHoriz As Worksheet, ShVert As Worksheet, Compte1 As Worksheet, Compte2 As Worksheet
Dim DerLig1 As Long, DerLig2 As Long

Application.ScreenUpdating = False
Set ShHoriz = Sheets("Liste Horizontale")
Set ShVert = Sheets("Liste Verticale")

'copie des élements de Compte1
Sheets("Compte1").Select
DerLig1 = Compte1.[A100000].End(xlUp).Row
Range("A1:A&DerLig1").Select
Selection.Copy
Sheets("ShVert").Select
ActiveSheet.Paste
'copie des élements de Compte2
Sheets("Compte2").Select
DerLig2 = Compte2.[A100000].End(xlUp).Row
Range("A1:A&DerLig2").Select
Selection.Copy
Sheets("ShVert").Select
ShVert.Cells(DerLig1, "A").Select
ActiveSheet.Paste
End Sub
Sub Reorganiser()
Dim ShHoriz As Worksheet, ShVert As Worksheet
Dim DerLig As Long, LigH As Long, LigV As Long, i As Long, NLigV As Long

Application.ScreenUpdating = False
Set ShHoriz = Sheets("Liste Horizontale")
Set ShVert = Sheets("Liste Verticale")

ShHoriz.Cells.ClearContents

DerLig = ShVert.[A100000].End(xlUp).Row
LigH = 2
LigV = 1
For i = 1 To DerLig
ShHoriz.Cells(LigH, "B") = ShVert.Cells(LigV, "A") 'Intitulé
If ShVert.Cells(LigV + 3, "A") = "Date" Then
ShHoriz.Cells(LigH, "C") = ShVert.Cells(LigV + 1, "A") 'Prix
ShHoriz.Cells(LigH, "D") = ShVert.Cells(LigV + 2, "A") 'Catégorie
ShHoriz.Cells(LigH, "A") = Format(ShVert.Cells(LigV + 4, "A"), "mm/dd") 'Date
ShHoriz.Cells(LigH, "E") = ShVert.Cells(LigV + 6, "A") 'Vues
ShHoriz.Cells(LigH, "F") = ShVert.Cells(LigV + 7, "A") 'Tel
ShHoriz.Cells(LigH, "G") = ShVert.Cells(LigV + 8, "A") 'Mails reçus
LigV = LigV + 9
Else
ShHoriz.Cells(LigH, "D") = ShVert.Cells(LigV + 1, "A") 'Catégorie
ShHoriz.Cells(LigH, "A") = Format(ShVert.Cells(LigV + 3, "A"), "mm/dd") 'Date
ShHoriz.Cells(LigH, "E") = ShVert.Cells(LigV + 5, "A") 'Vues
ShHoriz.Cells(LigH, "F") = ShVert.Cells(LigV + 6, "A") 'Tel
ShHoriz.Cells(LigH, "G") = ShVert.Cells(LigV + 7, "A") 'Mails reçus
LigV = LigV + 8
End If
LigH = LigH + 1
Next
'mise en place de la ligne des titres
ShHoriz.Range("A1:G1").Value = Array("Date", "Intitulé", "Prix", "Catégorie", "Vues", "Tel", "mails reçus")
'Mise en forme
Cells.Select
Selection.Columns.AutoFit
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:G1").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleNone
ShHoriz.Select

'Columns("C:C").NumberFormat = "#,##0.00 $"
Columns("C:C").NumberFormat = "#,##0"

'Tri par intitulés
Cells.Select
ActiveWorkbook.Worksheets("Liste Horizontale").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Liste Horizontale").Sort.SortFields.Add Key:=Range _
("B2:B1722"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Liste Horizontale").Sort
.SetRange Range("A1:G1722")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select

Set ShHoriz = Nothing
Set ShVert = Nothing
End Sub
Commenter la réponse de Guy_L
Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
Bonjour

DerLig1 = Compte1.[A100000].End(xlUp).Row

"Compte1" est le nom d'une feuille
   DerLig1 = Sheets("Compte1").[A100000].End(xlUp).Row

ou
Set Cpt1=sheets("Compte1")
DerLig1 = ShCpt1.[A100000].End(xlUp).Row


Pour déposer un fichier, allez sur
https://mon-partage.fr/

Chargez votre fichier
puis, en bas de page, cliquez sur "Uploader"

Copiez ici le lien fourni

Cdlt
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
OK, je vais faire ce changement, je comprends à présent l'intitulé "Liste Verticale" vs "ShVert"
Voici le lien du fichier: https://mon-partage.fr/f/X9Ez1RMA/
Commenter la réponse de Guy_L
Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
Voici avec quelques modifs.
Un bouton commun aux feuilles "Compte1" et "Compte2" , englobe la suppression des images, la mise en forme et l'export vers la feuille "Liste horizontale"
Pour les liens hypertextes, il me faudrait voir quelques exemples


Cliquez sur l'un des boutons des feuilles "Compte1" ou "Compte2" (lorsque les 2 feuilles sont remplies)
https://mon-partage.fr/f/4yL3aL90/

Cdlt
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
Ouf, c'est un sacré remaniement et je ne comprends pas tout.
Pour mieux se comprendre, j'ai repris le script que j'ai commenté en rouge dans le fichier joint à ce lien:
https://mon-partage.fr/f/bHmI4XrC/

Pour ne pas gêner la conception, j'avais renommé les onglets 1 et 2 en Compte 1 et Compte 2, ce qui vous a permis de simplifier le script en faisant des routine avec incrément. En réalité ces deux onglets portent des noms qui sont respectivement Pro et Perso, et, du coup, l'incrément ne fonctionne évidemment pas.
Un solution serait de les renommer le temps de passer les macros (en incluant le renommage avant le traitement et en changeant à nouveau leurs noms après), une autre solution serait de copier la macro en double pour effectuer le traitement l'un après l'autre.

Reste aussi un point qui n'a pas été "vu": pour distinguer les deux comptes, quand la moulinette a été passée, j'avais colorié en bleu les annonces du compte 1 et pas celles du compte 2 en faisant en sorte qu'ensuite, dans le tri alphabétique final, les lignes soient bleues ou noires selon le compte utilisé.

Je dois vous dire un grand merci déjà pour ce travail fantastique effectué jusqu'ici et qui me soulage quant-à la faisabilité (je n'y serais pas arrivé seul, même si je comprends quelques trucs en VBA).
Aussi, j'ai quelques scrupules à vous solliciter pour achever ce travail déjà bien avancé.
Merci d'avance.
Commenter la réponse de Guy_L
Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
Voilà avec les dernières modifs
https://mon-partage.fr/f/Lw1kQckP/

https://mon-partage.fr/f/F9u72wgq/

Cdlt
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
Alors, j'ai testé le script et voilà les résultats:
1) j'ai rectifié la variable dans la macro Traitement
If i = 1 Then Set ShVert = Sheets("Pro") Else Set ShVert = Sheets("Perso")
c'est f et non i qui change
2) la date c'est OK, même s'il faudra que je trouve le format jj/mm
3) les étapes se passent bien, mais les lignes se mettent en double avec un coup la couleur
du coup, je me suis demandé à quoi servaient ces deux lignes:
Compte1 = "Pro"
Compte2 = "Perso"
GL
Commenter la réponse de Guy_L
Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
1) j'ai rectifié la variable dans la macro Traitement
If i = 1 Then Set ShVert = Sheets("Pro") Else Set ShVert = Sheets("Perso")
Effectivement, j'avais oublié de changer la lettre de la variable

2) la date c'est OK, même s'il faudra que je trouve le format jj/mm
Ligne rajoutée à la fin pour mettre la colonne A au format jj/dd

3) les étapes se passent bien, mais les lignes se mettent en double avec un coup la couleur
Non, ça fonctionne correctement, mais dans l'exemple que vous aviez fourni, toutes les dates et tous les prix étaient identiques. j'ai mis des valeurs différentes et tout est OK.

je me suis demandé à quoi servaient ces deux lignes:
Compte1 = "Pro"
Compte2 = "Perso"

Dans votre précédent Post, vous aviez dit que les vrais noms des feuilles étaient "PRO" et "PERSO", donc pour avoir un programme unique quel que soit le nom de la feuille et travailler en boucle il fallait un nom commun , j'ai conservé "Compte" auquel on ajoute la variable i pour tester les 2 feuilles. Est-ce plus clair?

https://mon-partage.fr/f/jio3YiRi/

Cdlt
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
2) OK, je vérifierai, mais ça doit marcher (au cas où ça ne serait pas le cas, je vous le dirai)

3) En fait non, car j'ai collé les "vraies" annonces dans le fichier et ça donne le résultat que je vous ai dit (doublons avec une ligne bleue et la suivante noire), mais... je pense avoir trouvé pourquoi:
dans la version précédente que vous m'avez envoyée, il y a ces lignes:
For f = 1 To 2
If i = 1 Then Set ShVert = Sheets("Pro") Else Set ShVert = Sheets("Perso")

> à nouveau, c'est la variable f vs i qui pose problème

Pour les "Compte1 et 2":
J'avais compris ça, mais dans le script précédent il y avait cette ligne:
Set ShVert = Sheets("Compte" & f)

elle justifiait la correspondance avec les noms des onglets.
Et, en effet, je vous ai communiqué ensuite le nom réel des onglets, le mot "Compte" devrait avoir disparu ou alors être utilisé à nouveau dans l'incrément comme dans la ligne ci-dessus. Mais cette ligne a disparu du script et il y a celle-ci à la place (qui prend le nom réel des deux onglets):
If f = 1 Then Set ShVert = Sheets("Pro") Else Set ShVert = Sheets("Perso")

C'est pourquoi je ne comprends pas à quoi servent ces deux noms "Compte1" et "Compte2"

Il faudrait aussi que je comprenne la relation entre les deux dénominations, je m'explique:

Dans la ligne "Set ShHoriz = Sheets("Liste Horizontale")" le nom réel de la feuille est "Liste Horizontale" (on retrouve ce nom sur l'onglet de la feuille et dans le champ Name de ses propriétés (sous Développeur).

Le nom ShHoriz est donc celui utilisé dans le script pour désigner cette feuille si j'ai bien compris.

Donc, toujours d'après ce raisonnement, si j'applique la même logique pour
Compte1 = "Pro"
Compte2 = "Perso"

"Compte1" est le nom d'une feuille, mais ce nom n'est plus utilisé dans le script ...

Me trompe-je ? :-)
Commenter la réponse de Guy_L
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
Ça y est, j'ai testé, tout fonctionne.
Je vais maintenant le peaufiner. Par exemple, ça m'intéresserait de savoir comme faire pour que l'année de la date soit "réelle":
Comme le copier-coller depuis le site du Bon Coin n'analyse pas la réalité de la date, il prend l'année courante en compte (c'est comme ça que j'ai trouvé le 16/12/2019 par exemple).
Il faudrait donc une ligne qui fasse le test
"est-ce qu'on a déjà dépassé le 31/12 ? si oui, prendre l'année dernière, sinon, rester sur l'année courante"

Pour le reste, un énorme merci, car non seulement ça marche, mais j'ai appris pas mal de choses.
Commenter la réponse de Guy_L
Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
Bonjour,

Avec le traitement de la date
https://mon-partage.fr/f/Xiy3EmDR/

Cdlt
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
Merci, il va falloir que je prenne le temps de "décortiquer" ces lignes de programme, car je ne connais pas, par exemple "CDate" Mais je vais chercher
J'imagine que ça doit fonctionner (je n'ai pas eu le temps de tester, donc merci.
Bien à vous
GL
Commenter la réponse de Guy_L
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
Bonjour,
Avec les données réelles, il y a un bug qui "coince" sur cette ligne
ShHoriz.Cells(LigH, "A") = Format(Day(ShVert.Cells(LigV + 3, "A")) & "/" & Month(ShVert.Cells(LigV + 4, "A")) & "/" & Year(Date) - 1, "mm/dd/yyyy") 'on prend l'année précédente
Je ne sais pas comment, mais j'ai quand même obtenu à un moment le résultat suivant (voir copie écran)
https://mon-partage.fr/f/90qNAl5E/
et, comme vous pourrez le constater, certaines dates 2019 sont quand même passées (novembre et décembre 2019) de manière un peu aléatoire.
Cdlt
Commenter la réponse de Guy_L
Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
Bonjour,

Ce qu'il me faudrait c'est plutôt un échantillon de l'extraction brute pour que je puisse tester, pas une image.
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
Commenter la réponse de Guy_L
Messages postés
1874
Date d'inscription
lundi 6 mai 2013
Dernière intervention
6 février 2019
231
0
Merci
Ce qu'il me faudrait c'est plutôt un échantillon de l'extraction brute avant traitement
Commenter la réponse de Frenchie83
Messages postés
105
Date d'inscription
samedi 16 septembre 2006
Dernière intervention
20 janvier 2019
0
Merci
Ah OK, excusez, j'avais mal compris.
Là c'est un peu embêtant, car je ne peux pas mettre en ligne des données dont certaines sont professionnelles (trop sensible question confidentialité). Mais j'ai simplement enlevé les objets pour ne laisser que les dates puisque le sujet est là.

https://mon-partage.fr/f/Gyos7wNK/
Commenter la réponse de Guy_L