Re: Sélection de données, copie et organisation |
Titre du sujet : Re: Sélection de données, copie et organisation par myDearFriend! le 23/08/2018 17:36:29 Bonjour KeepCool, le Forum,
Il y a une infinité de façons de faire pour ce type d'opération.
Voici mon interprétation du traitement VBA : DANS UN MODULE DE CODE STANDARD Option Explicit Sub Traitement() '-------------------------------------- ' myDearFriend! - www.mdf-xlpages.com '-------------------------------------- Dim vTab As Variant Dim FSource As Worksheet, FCible As Worksheet Dim Plage As Range, rLign As Range, R As Range Dim vText As String, vDate As String, vReunion As String Dim L As Long, C As Long, lgnDebutTab As Long, lgnFinTab As Long, Lcible As Long, CCible As Long Set FSource = Sheets("Feuil1 Page Web Récupérée") 'à adapter Set FCible = Sheets("Feuille 2 Résultat Attendu") 'à adapter 'COLLECTE DONNEES With FSource 'A quelle ligne commence le tableau (de 8 colonnes) ? lgnDebutTab = .Cells(1, 8).End(xlDown).Row '1ère donnée rencontrée en descendant la colonne H If lgnDebutTab = 0 Then Exit Sub 'si aucun tableau trouvé! 'A quelle ligne se termine ce tableau ? lgnFinTab = .Cells(1048576, 8).End(xlUp).Row '1ère donnée rencontrée en remontant la colonne H If lgnFinTab = lgnDebutTab Then Exit Sub 'si le tableau est vide! 'On récupère et mémorise les données sources souhaitées dans un tableau variant vTab = .Range(.Cells(lgnDebutTab + 1, 1), .Cells(lgnFinTab, 8)).Value 'On récupère et mémorise la Date de la course et le n° de Réunion ? For L = 1 To lgnDebutTab - 1 vText = .Cells(L, 1).Value If Len(vText) - Len(Replace(vText, "-", "")) = 2 Then 'Il y a 2 "-" dans l'expression trouvée vDate = Mid(vText, InStr(1, vText, "-") + 2, 10) vReunion = .Cells(L - 1, 1).Value Exit For End If Next L End With 'MAJ RESULTATS With FCible 'On efface les anciens résultats .Cells.ClearContents 'Pour chaque ligne du tableau mémorisé For L = 1 To UBound(vTab, 1) If Left(vTab(L, 1), 1) = "C" Then Lcible = Lcible + 1 CCible = 2 'Pour chaque colonne source For C = 1 To 8 Select Case C Case 1 'Date en colonne 1 .Cells(Lcible, 1).Value = vDate 'Réunion en colonne 2 .Cells(Lcible, 2).Value = vReunion & vTab(L, C) CCible = CCible + 1 Case 5, 7 CCible = CCible + 1 .Cells(Lcible, CCible).Value = vTab(L, C) Case 8 CCible = CCible + 1 .Cells(Lcible, CCible).Value = Val(Mid(vTab(L, C), 21)) End Select Next C End If Next L End With MsgBox "Traitement terminé!"
En pièce jointe, ton fichier adapté en conséquence.
En espérant t'avoir dépanné...
Bien cordialement, |
Forums