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

Question

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

Frenchie83 · Answer

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

Guy_L · Answer

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

Frenchie83 · Answer

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?

Guy_L · Answer

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").SelectDim 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 WithEnd SubSub 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.AutoFitEnd SubSub 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.PasteEnd SubSub 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 = NothingEnd Sub

Frenchie83 · Answer

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

Guy_L · Answer

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/

Frenchie83 · Answer

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

Guy_L · Answer

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.

Frenchie83 · Answer

Voilà avec les dernières modifs
https://mon-partage.fr/f/Lw1kQckP/

https://mon-partage.fr/f/F9u72wgq/

Cdlt

Guy_L · Answer

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

Frenchie83 · Answer

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

Guy_L · Answer

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 ?      :-)

Guy_L · Answer

Ç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.

Frenchie83 · Answer

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

Guy_L · Answer

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

Guy_L · Answer

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

Frenchie83 · Answer

Bonjour,

Ce qu'il me faudrait c'est plutôt un échantillon de l'extraction brute pour que je puisse tester, pas une image.

Guy_L · Answer

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

Frenchie83 · Answer

Ce qu'il me faudrait c'est plutôt un échantillon de l'extraction brute avant traitement

Guy_L · Answer

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/

Frenchie83 · Answer

2 erreurs détectées
La première: erreur de saisie de ma part(un + 1 à la place de * 1)
If CDate(Left(ShVert.Cells(LigV + 4, "A"), 10)) * 1 > Date + 1 Then 'Si la date est supérieure à celle d'aujourd'hui

 la correction:
If CDate(Left(ShVert.Cells(LigV + 4, "A"), 10)) * 1 > Date * 1 Then 'Si la date est supérieure à celle d'aujourd'hui

La deuxième: dans la liste "Pro", une date était mal écrite: 11/021/2019 au lieu de 11/12/2019

https://mon-partage.fr/f/PmyE3nry/

Essayez à nouveau

Guy_L · Answer

Hélas, ça butte toujours sur cette deuxième ligne:
If CDate(Left(ShVert.Cells(LigV + 3, "A") * 1, 10)) * 1 > Date * 1 Then 'Si la date est supérieure à celle d'aujourd'hui
                    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

et dans le fichier "réel", il y a encore des dates du type 29/11/2019

Dans le fichier Classeur 3 ci-dessous j'ai mis deux annonces symptomatiques (toutes deux dans "Pro")
https://mon-partage.fr/f/pwZ4XesD/
La première "passe" (date OK 29/11/2018), la seconde non (29/11/2019)

Frenchie83 · Answer

Encore une bourde (copier-coller non corrigé)
dans la 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

remplacez le 4( en gras) par 3, ce qui donne
                    ShHoriz.Cells(LigH, "A") = Format(Day(ShVert.Cells(LigV + 3, "A")) & "/" & Month(ShVert.Cells(LigV + 3, "A")) & "/" & Year(Date) - 1, "mm/dd/yyyy") 'on prend l'année précédente

Essayez

Guy_L · Answer

Je pense que le problème était dans le Else:

Script initial
ShHoriz.Cells(LigH, "A") = Format(ShVert.Cells(LigV + 3, "A"), "mm/dd") 'Date
> avec donc un test sur la ligne + 3 alors qu'avec le prix, elle est décalée en + 4

Script corrigé
ShHoriz.Cells(LigH, "A") = Format(ShVert.Cells(LigV + 4, "A"), "mm/dd/yyyy") 'Date

J'ai aussi corrigé ces lignes
 'Contrôle de la date                If CDate(Left(ShVert.Cells(LigV + 4, "A"), 10)) * 1 > Date * 1 Then 'Si la date est supérieure à celle d'aujourd'hui                    ShHoriz.Cells(LigH, "A") = Format(Day(ShVert.Cells(LigV + 3, "A")) & "/" & Month(ShVert.Cells(LigV + 3, "A")) & "/" & Year(Date) - 1, "mm/dd/yyyy") 'on prend l'année précédente                Else                    ShHoriz.Cells(LigH, "A") = Format(ShVert.Cells(LigV + 4, "A"), "mm/dd/YYYY") 'sinon on conserve la date
en
 'Contrôle de la date                If CDate(Left(ShVert.Cells(LigV + 3, "A"), 10)) * 1 > Date * 1 Then 'Si la date est supérieure à celle d'aujourd'hui                    ShHoriz.Cells(LigH, "A") = Format(Day(ShVert.Cells(LigV + 3, "A")) & "/" & Month(ShVert.Cells(LigV + 3, "A")) & "/" & Year(Date) - 1, "mm/dd/yyyy") 'on prend l'année précédente                Else                    ShHoriz.Cells(LigH, "A") = Format(ShVert.Cells(LigV + 3, "A"), "mm/dd/YYYY") 'sinon on conserve la date

Pour autant, la macro bute à nouveau sur 
ShHoriz.Cells(LigH, "A") = Format(Day(ShVert.Cells(LigV + 3, "A")) & "/" & Month(ShVert.Cells(LigV + 3, "A")) & "/" & Year(Date) - 1, "mm/dd/yyyy") 'on prend l'année précédente

????

Frenchie83 · Answer

Je me suis mal fait comprendre, c'était justement la ligne du "Else" (celle en gras)
        For i = 1 To DerLigV
            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
                'Contrôle de la date
                If CDate(Left(ShVert.Cells(LigV + 4, "A"), 10)) * 1 > Date + 1 Then 'Si la date est supérieure à celle d'aujourd'hui
                    ShHoriz.Cells(LigH, "A") = Format(Day(ShVert.Cells(LigV + 4, "A")) & "/" & Month(ShVert.Cells(LigV + 4, "A")) & "/" & Year(Date) - 1, "mm/dd/yyyy") 'on prend l'année précédente
                Else
                    ShHoriz.Cells(LigH, "A") = Format(ShVert.Cells(LigV + 4, "A"), "mm/dd/YYYY") 'sinon on conserve la date
                End If
                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
                'Contrôle de la date
                If CDate(Left(ShVert.Cells(LigV + 3, "A") * 1, 10)) * 1 > Date * 1 Then 'Si la date est supérieure à celle d'aujourd'hui
                    ShHoriz.Cells(LigH, "A") = Format(Day(ShVert.Cells(LigV + 3, "A")) & "/" & Month(ShVert.Cells(LigV + 3, "A")) & "/" & Year(Date) - 1, "mm/dd/yyyy") 'on prend l'année précédente
                Else
                    ShHoriz.Cells(LigH, "A") = Format(ShVert.Cells(LigV + 3, "A"), "mm/dd/YYYY") 'sinon on conserve la date
                End If
                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

https://mon-partage.fr/f/NDPeON2W/

Cdlt

Guy_L · Answer

En effet, j'avais changé la partie avant le Else, pas celle d'après. Maintenant, tout semble fonctionner à merveille. Comment vous remercier ?

Frenchie83 · Answer

Si tout fonctionne correctement, mettre en résolu.

Cdlt

Guy_L · Answer

OK, non sans un grand merci

Extraire une liste à partir d'un copier-coller de site - Page 2

Discussions similaires

Newsletters