Rapport de message :*
 

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,