Traitement Extract

Bonjour le forum,

J'espère que vous allez bien et que vous vivez bien cette vague de chaleur.

Grâce à l'entraide sur le forum, j'avance considérablement dans mon projet, et je vous en remercie sincèrement !

Cette fois, je viens à vous car j'aimerai réaliser une macro dont j'ai ecris les instructions dans le PDF.

J'ai laissé une question ouverte pour écrire le nom des pays. Je suis ouvert à toutes vos propositions car je ne connais pas tous le potentiel qu'Excel regorge pour trouver des solutions à mon problème ahha.

Je vous remercie par avance pour votre temps et pour votre aide. Je vous souhaite un bon après-midi et hydratez-vous les amis !

Laplacea

14extract-fs.xlsx (18.53 Ko)

Bonjour LaplaceA

Voila quelque chose qui devrait aller

Mais il y a du travail à faire

La feuille CLUBS est à compléter

il faudra y trouver tous les noms des clubs de tous les pays et naturellement le nom du pays

La feuille "Point de Départ" se sert de cette liste pour mettre le nom des PAYS

Bon Championnat

Cdt

11extract-fs001.xlsm (27.40 Ko)

Hello Toukoul, Bonjour le forum,

Je te remercie pour ton retour et pour le temps que tu as consacré à ma demande ^^

Ton idée est bonne mais elle présente quelques désavantages en terme d'analyse car cela revient à accorder le nom d'une équipe à un pays alors que parfois cette même équipe va joue sur la scène continentale voir mondiale, et je veux éviter ça.

Crois-tu qu'il est possible de partir de mon idée de départ de construire une liste de tous les pays du monde que je souhaite analyser (une centaine), et de créer une macro qui, dans la colonne championnat, analyse les premiers termes de chaque cellule et réussit à identifier s'il correspond à ceux de la liste ?

Par exemple, si la macro traite une cellule inscrit "ItalieSeriA", qu'elle reconnaisse le terme "Italie" et qu'elle l'inscrive ?

Je te remercie pour ton retour et d'avoir proposé une solution. Je suis ouvert à toutes nouvelles solutions.

A ta disposition

Bien à toi.

Laplacea

Bonsoir laplacea, Toukoul, le forum,

Un essai.....

Une contrainte: avoir une liste de Pays (Feuille "Liste des Pays" que tu pourras alimenter à ta guise).

CTRL + E pour exécuter la macro "laplacea"

Cordialement,

Bonsoir Xorsankukai, Toukoul, le forum,

Je te remercie pour ton retour, et la macro correspond à ce que j'attends !

J'ai suivi ton conseil où j'ai complété la liste des pays

J'aimerai ajouter des actions pour compléter la macro.

1- J'aimerais que la feuille prenne le nom de la date où la macro a été activé. Je ne sais pas si c'est possible avec un fonction du type "aujourd'hui", au format JJ/MM.

2- Supprimer les lignes où il le nom du pays est pas présent (car il ne figure pas dans la liste des pays étudiés)

equipe

3- Supprimer les lignes où il n'y a pas de contenu dans la colonne C, D, E et F. (car cela veut dire qu'il n'y a pas d'équipes, ou de score donc rien à analyser)

pays ssss

Je te remercie par avance et merci encore pour ta grande disponibilité Xorsankukai.

Prends soin de toi.

Laplacea

Bonjour LaplaceA, Xorsankukai

Premier essai sur ce forum remis à neuf

Ce n'est que le fichier de Xorsankukai avec les dernières demandes

Cdt Toukoul

Bonjour laplacea, Toukoul ,le forum,

Une variante à tester....(au lieu de supprimer, on n'écrit pas si une des colonnes est vide...)

Cordialement,

Bonjour Toukoul, Xorsankukai, le forum

Je vous remercie de votre retour et j'espère que vous allez bien !

Je vous remercie pour vos différentes macros qui me permettent d'obtenir le résultat que je souhaite ! Je me suis rendu compte au finale que j'ai oublié un détail que je corrigerai quand j'avancerai dans le traitement de mes données ^^'.

J'aimerais vous demander une macro que je vais utiliser une fois, mais qui me fera gagner bien du temps et économiser mon énergie ^^.

J'aimerais que cette macro crée une nouvelle feuille de calcul pour chaque pays situé dans l'onglet "Liste de pays" présent dans l'Excel joint, et que les feuilles crées prennent le nom du pays.

Par exemple, la première feuille qu'ajoutera la macro sera la feuille "AFRIQUE DU SUD", la deuxième "ALBANIE", etc.. jusqu'à la 164ᵉ feuille crée qui s'appellera "ZIMBABWE"

Je vous remercie par avance et merci encore de contribuer au développement de mon projet.

Je vous souhaite un bon dimanche.

Laplacea

liste pays

Re,

J'aimerais que cette macro crée une nouvelle feuille de calcul pour chaque pays situé dans l'onglet "Liste de pays" présent dans l'Excel joint, et que les feuilles crées prennent le nom du pays.

Sub ajout_feuilles()
    Dim nom As String, c As Range

    Application.ScreenUpdating = False

    For Each c In Sheets("Liste des Pays").Range("A2:A" & Sheets("Liste des Pays").Range("A" & Rows.Count).End(xlUp).Row)
        nom = c.Value
        If nom <> "" Then
            Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = nom
        End If
    Next c
End Sub

Une variante qui teste si la feuille est déjà présente....

Cordialement,

Bonsoir Xorsankukai, le forum,

C'est super, j'obtiens bien les feuilles de calculs que je souhaite ! Tu m'as fait économisé de nombreuses minutes ^^

Je te remercie beaucoup !

Je te souhaite une bonne soirée, voire une bonne journée en avance.

Prends soin de toi.

Laplacea

Hello Xorsankukai, Toukoul, le forum,

J'espère que vous allez bien.

J'aimerai compléter la macro pour combler un problème dans l'extraction des données.

prolong

Ici, pour la ligne j'aimerai enlever les scores en colonne E (2) et F (2), pour les remplacer par (2) en E et (1) en F, et enlever "(2 - 1); " pour avoir uniquement dans la colonne G (0 - 0) pour conserver la mise en forme des autres lignes qui sont correctes.

Ainsi, j'aimerais que la macro analyse chaque ligne de l'extraction du jour, si elle détecte sur une ligne qu'en colonne G, il y a plus de 7 caractères (correspondant au nombres de caractères pour écrire "(0 - 0)", alors :

- elle supprime les informations présentes en colonne E et la remplace par le 2ème caractère de colonne G (2 dans notre exemple)

- elle supprime les informations présentes en colonne F et la remplace par le 5ème caractère de colonne G (1 dans notre exemple)

- elle supprime les 9 premiers caractères de la colonne G pour obtenir le seul score correct entre parenthèse. (ici (0 - 0) dans notre exemple)

L'objectif étant d'obtenir ce résultat :

res
5extract.xlsm (127.60 Ko)

Je suis à votre disposition au besoin et je vous en remercie par avance !

Je vous souhaite une bonne journée.

Laplacea

Bonjour laplacea, le forum,

Ainsi, j'aimerais que la macro analyse chaque ligne de l'extraction du jour, si elle détecte sur une ligne qu'en colonne G, il y a plus de 7 caractères ....

A tester....

Sub Score()

    Dim dl As Long, i As Long

 Application.ScreenUpdating = False

   With ActiveSheet
            dl = .Range("B" & Rows.Count).End(xlUp).Row    'dernière ligne de la colonne B
        For i = 3 To dl                                    'boucle de la ligne 3 à la dernière
          .Range("G" & i) = Trim(.Range("G" & i))          'supprime les espaces inutiles
         If Len(.Range("G" & i)) > 7 Then                  'si nombre de caractère de la cellule G > 7
          .Range("E" & i) = Mid(.Range("G" & i), 2, 1)     'deuxième caractère de la cellule G en E
          .Range("F" & i) = Mid(.Range("G" & i), 6, 1)     'sixième caractère de la cellule G en F
          .Range("G" & i) = Split(Range("G" & i), ";")(1)  'caractères de la cellule G situé après le ;
         End If
        Next i
   End With
End Sub
3extract-v1.xlsm (139.18 Ko)

ctrl + e pour lancer la macro....

Cordialement,

Re,

A vérifier....

Option Explicit
Option Compare Text

Dim tabloA, tabloC, tabloD()
Dim i&, ln&
Dim dernligne As Long
Dim tablo(), tabloR()
Dim plage As Range, k

Sub laplacea()

   Application.ScreenUpdating = False

   If ActiveSheet.Name <> "Liste des Pays" Then
     dernligne = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To dernligne - 1
    If ActiveSheet.Range("G" & i + 1) = "" Then ActiveSheet.Range("G" & i + 1) = ActiveSheet.Range("G" & i)    'remplissage des vides
   Next i

    tabloA = Sheets("Liste des Pays").Range("A2:A" & Sheets("Liste des Pays").Range("A" & Rows.Count).End(xlUp).Row)
    tabloC = ActiveSheet.Range("G2:G" & dernligne)
    ReDim tabloD(UBound(tabloC, 1), 1)

    For i = 1 To UBound(tabloC, 1)
        For ln = 1 To UBound(tabloA, 1)
            If Left(tabloC(i, 1), 4) Like Left(tabloA(ln, 1), 4) Then
                tabloD(i - 1, 0) = tabloA(ln, 1)      'correspondance sur feuille Liste des Pays
            End If
        Next ln
    Next i
    ActiveSheet.Range("I2").Resize(UBound(tabloD, 1)) = tabloD
    Erase tabloD

   With ActiveSheet
     Set plage = .Range("A2:I" & dernligne)
         tablo = plage
     k = 0
      For i = 1 To UBound(tablo, 1)
         ReDim Preserve tabloR(1 To 6, 1 To k + 1)
          If tablo(i, 9) <> "" And tablo(i, 3) <> "" And tablo(i, 4) <> "" And tablo(i, 5) <> "" And tablo(i, 6) <> "" Then
            tabloR(1, k + 1) = tablo(i, 9)
            tabloR(2, k + 1) = tablo(i, 2)
            tabloR(3, k + 1) = tablo(i, 5)
            tabloR(4, k + 1) = tablo(i, 3)
            tabloR(5, k + 1) = tablo(i, 4)
            tabloR(6, k + 1) = tablo(i, 6)
            k = k + 1
          End If
      Next i
       On Error Resume Next
       .Cells.Delete
       .Range("B2") = "CHAMPIONNAT": .Range("B2").Font.Bold = True: .Range("B2").Interior.ColorIndex = 6
       .Range("C2") = "H team": .Range("C2").Font.Bold = True
       .Range("D2") = "A team": .Range("D2").Font.Bold = True
       .Range("E2") = "H goal": .Range("E2").Font.Bold = True
       .Range("F2") = "A goal": .Range("F2").Font.Bold = True
       .Range("G2") = "HT goal": .Range("G2").Font.Bold = True
       .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tabloR, 2), 6) = Application.Transpose(tabloR)
       Erase tabloR
       .Columns.AutoFit
       .Name = Format(Date, "dd-mm")

       For i = 3 To dernligne                              'boucle de la ligne 3 à la dernière
          .Range("G" & i) = Replace(Range("G" & i), " ", "")        'supprime les espaces inutiles
         If Len(.Range("G" & i)) > 7 Then                  'si nombre de caractère de la cellule G > 7
          .Range("E" & i) = Mid(.Range("G" & i), 2, 1)     'deuxième caractère de la cellule G en E
          .Range("F" & i) = Mid(.Range("G" & i), 4, 1)     'quatrième caractère de la cellule G en F
          .Range("G" & i) = Split(Range("G" & i), ";")(1)  'caractères de la cellule G situé après le ;
         End If
        Next i
   End With
   End If
End Sub

Cordialement,

Bonsoir Xorsankukai, le forum,

Merci c'est parfait !

J'aimerais ajouter une macro qui s'inspirerait d'une précédente macro (sur ce sujet : https://forum.excel-pratique.com/excel/tableau-donnees-142045 ) partant de ce point de départ avec l'image ci-dessous :

capture macro 1

Avec le code suivant :

Option Explicit

Public Sub test(poOnglet As Worksheet)
    Dim tablo(), tabloR(), tabloS()
    Dim dl As Long, plage As Range, k, i

 Application.ScreenUpdating = False

   With poOnglet
    .Activate
            dl = .Range("B" & Rows.Count).End(xlUp).Row
     Set plage = .Range("B3:I" & dl)
         tablo = plage
     k = 0
      For i = 1 To UBound(tablo, 1)
         ReDim Preserve tabloR(1 To 6, 1 To k + 1)
         ReDim Preserve tabloS(1 To 6, 1 To k + 1)
            tabloR(1, k + 1) = tablo(i, 1)
            tabloR(2, k + 1) = tablo(i, 3)
            tabloR(3, k + 1) = tablo(i, 5)
            tabloR(4, k + 1) = tablo(i, 6)
            tabloR(5, k + 1) = tablo(i, 7)
            tabloR(6, k + 1) = tablo(i, 8)

            tabloS(1, k + 1) = tablo(i, 2)
            tabloS(2, k + 1) = tablo(i, 4)
            tabloS(3, k + 1) = tablo(i, 5)
            tabloS(4, k + 1) = tablo(i, 6)
            tabloS(5, k + 1) = tablo(i, 7)
            tabloS(6, k + 1) = tablo(i, 8)
            k = k + 1
      Next i
       On Error Resume Next
       .Cells.Delete
       .Range("B2") = "TEAM": .Range("B2").Font.Bold = True: .Range("B2").Interior.ColorIndex = 6
       .Range("C2") = "H team": .Range("C2").Font.Bold = True
       .Range("D2") = "FTHG": .Range("D2").Font.Bold = True
       .Range("E2") = "FTAG": .Range("E2").Font.Bold = True
       .Range("F2") = "HTHG": .Range("F2").Font.Bold = True
       .Range("G2") = "HTAG": .Range("G2").Font.Bold = True
       .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tabloR, 2), 6) = Application.Transpose(tabloR)
       .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tabloS, 2), 6) = Application.Transpose(tabloS)
       Erase tabloR
       Erase tabloS
       .Range("B3:G" & .Range("B" & Rows.Count).End(xlUp).Row).Sort .Range("C3"), xlAscending, .Range("B3"), , xlAscending
       .Columns("C:C").AutoFit
   End With

End Sub

Public Sub XXXX()
  Dim oSh As Worksheet
    For Each oSh In ActiveWindow.SelectedSheets
        test oSh
    Next oSh
End Sub

Pour obtenir le résultat suivant :

resultat macro

Sauf que dans notre fichier Excel, nous partons de ce point de départ :

macro 22

Et j'aimerais arriver au résultat figurant à l'image ci-dessus qui est incomplète car on ne peut pas voir toutes les lignes. J'ai inclus une feuille "Résultat" si tu souhaite te vérifier.

resultat

J'ai pensé qu'une solution pour pouvoir utiliser plus facilement le code précedent est de créer une colonne en C où l'on ferait un copie-colle de la colonne B.

J'aimerais en plus ajouter un filtre par ordre alphabétique pour la colonne "TEAM".

Je te remercie par avance pour ton aide et te souhaite un bon dimanche !

Bien à toi.

Laplacea

5lastv-extract.xlsm (72.98 Ko)

Bonjour laplacea, le forum,

Un essai........la macro est dans le module1.....ctrl+e pour l'exécuter

Option Explicit

Public Sub essai(poOnglet As Worksheet)
    Dim tablo(), tabloR(), tabloS()
    Dim dl As Long, plage As Range, k, i

 Application.ScreenUpdating = False

   With poOnglet
    .Activate
            dl = .Range("B" & Rows.Count).End(xlUp).Row
     Set plage = .Range("B3:H" & dl)
         tablo = plage
            k = 0
      For i = 1 To UBound(tablo, 1)
         ReDim Preserve tabloR(1 To 8, 1 To k + 1)
         ReDim Preserve tabloS(1 To 8, 1 To k + 1)
            tabloR(1, k + 1) = tablo(i, 1)               'Team
            tabloR(2, k + 1) = tablo(i, 2)               'H team
            tabloR(3, k + 1) = tablo(i, 4)               'FTHG
            tabloR(4, k + 1) = tablo(i, 5)               'FTAG
            tabloR(5, k + 1) = tablo(i, 4) + tablo(i, 5) 'somme FTHG et FTAG
            tabloR(6, k + 1) = tablo(i, 6)               'HTHG
            tabloR(7, k + 1) = tablo(i, 7)               'HTAG
            tabloR(8, k + 1) = tablo(i, 6) + tablo(i, 7) 'somme HTHG et HTAG

            tabloS(1, k + 1) = tablo(i, 1)
            tabloS(2, k + 1) = tablo(i, 3)
            tabloS(3, k + 1) = tablo(i, 4)
            tabloS(4, k + 1) = tablo(i, 5)
            tabloS(5, k + 1) = tablo(i, 4) + tablo(i, 5)
            tabloS(6, k + 1) = tablo(i, 6)
            tabloS(7, k + 1) = tablo(i, 7)
            tabloS(8, k + 1) = tablo(i, 6) + tablo(i, 7)
            k = k + 1
      Next i
       On Error Resume Next
       .Cells.Delete
       .Range("B2") = "TEAM": .Range("B2").Font.Bold = True: .Range("B2").Interior.ColorIndex = 6
       .Range("C2") = "H team": .Range("C2").Font.Bold = True
       .Range("D2") = "FTHG": .Range("D2").Font.Bold = True
       .Range("E2") = "FTAG": .Range("E2").Font.Bold = True
       .Range("F2") = "NBFTG": .Range("F2").Font.Bold = True
       .Range("G2") = "HTHG": .Range("G2").Font.Bold = True
       .Range("H2") = "HTAG": .Range("H2").Font.Bold = True
       .Range("I2") = "NBHTG": .Range("I2").Font.Bold = True
       .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tabloR, 2), 8) = Application.Transpose(tabloR)
       .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tabloS, 2), 8) = Application.Transpose(tabloS)
       Erase tabloR
       Erase tabloS
       .Range("B3:I" & .Range("B" & Rows.Count).End(xlUp).Row).Sort .Range("B3"), xlAscending, .Range("C3"), , xlAscending
       .Columns.AutoFit
   End With

End Sub

Public Sub XXXX()
  Dim oSh As Worksheet
    For Each oSh In ActiveWindow.SelectedSheets
        essai oSh
    Next oSh
End Sub

Bon dimanche,

Hello Xorsankukai, le forum,

Merci pour ta solution. Finalement tu as obtenu le même résultat que moi. Je pense que ça doit être mes hypothèses de départ qui ne sont pas bonnes. ^^

J'ai écrit dans le PDF les instructions que j'ai fait à la main et qui m'ont donné le résultat que je souhaitais. Je pense que ça beaucoup ressembler à la macro que tu as rédigé mais il doit y avoir une ou quelques modifications à passer.

Je te remercie par avance pour ton temps et je te souhaite également un bon dimanche.

Bien sincèrement.

Adrien.

Re à tous !

J'aimerais en plus ajouté à cette macro 2 actions à la toutes fin qui partirait à chaque fois de la ligne 3 et qui analyse chaque ligne où du contenu est présent :

- Ajouter une colonne en F, nommer en F2 "NBFTG", puis faire la somme pour chaque ligne des colonnes D+E. Exemple : F3=D3+E3

- Ajouter une colonne en I, nommer en I2 "NBFTG", puis faire la somme pour chaque ligne des colonnes G+H. Exemple : I3=G3+H3

Puis renommer C2 : "TEAM"

Je vous remercie par avance et bon après-midi !

ngtg

Re,

En réponse à ton post https://forum.excel-pratique.com/s/goto/884802

A tester....

Option Explicit

Public Sub essai(poOnglet As Worksheet)
    Dim tablo(), tabloR(), tabloS()
    Dim dl As Long, plage As Range, k, i

 Application.ScreenUpdating = False

   With poOnglet
    .Activate
            dl = .Range("B" & Rows.Count).End(xlUp).Row
     Set plage = .Range("B3:H" & dl)
         tablo = plage
            k = 0
      For i = 1 To UBound(tablo, 1)
         ReDim Preserve tabloR(1 To 6, 1 To k + 1)
         ReDim Preserve tabloS(1 To 6, 1 To k + 1)
            tabloR(1, k + 1) = tablo(i, 1)               'Championnat
            tabloR(2, k + 1) = tablo(i, 2)               'H Team
            tabloR(3, k + 1) = tablo(i, 4)               'H go
            tabloR(4, k + 1) = tablo(i, 5)               'A go
            tabloR(5, k + 1) = tablo(i, 6)               'H HT G
            tabloR(6, k + 1) = tablo(i, 7)               'A HT G

            tabloS(1, k + 1) = tablo(i, 1)               'Championnat
            tabloS(2, k + 1) = tablo(i, 3)               'A team
            tabloS(3, k + 1) = tablo(i, 5)               'A go
            tabloS(4, k + 1) = tablo(i, 4)               'H go
            tabloS(5, k + 1) = tablo(i, 7)               'A HT G
            tabloS(6, k + 1) = tablo(i, 6)               'H HT G
            k = k + 1
      Next i
       On Error Resume Next
       .Cells.Delete
       .Range("B2") = "TEAM": .Range("B2").Font.Bold = True: .Range("B2").Interior.ColorIndex = 6
       .Range("C2") = "H team": .Range("C2").Font.Bold = True
       .Range("D2") = "H gaol": .Range("D2").Font.Bold = True
       .Range("E2") = "A goal": .Range("E2").Font.Bold = True
       .Range("F2") = "H HT G": .Range("F2").Font.Bold = True
       .Range("G2") = "A HT G": .Range("G2").Font.Bold = True
       .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tabloR, 2), 6) = Application.Transpose(tabloR)
       .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tabloS, 2), 6) = Application.Transpose(tabloS)
       Erase tabloR
       Erase tabloS
       .Range("B3:I" & .Range("B" & Rows.Count).End(xlUp).Row).Sort .Range("B3"), xlAscending, .Range("C3"), , xlAscending
       .Columns.AutoFit
   End With

End Sub

Public Sub XXXX()
  Dim oSh As Worksheet
    For Each oSh In ActiveWindow.SelectedSheets
        essai oSh
    Next oSh
End Sub

Est-ce bien le résultat attendu ?

Cordialement,

Bonjour à tous,

Salut Xorsankukai

Wouah! on s'améliore dans l'utilisation tableau. Même pas besoin de venir sur le sujet...

Sauf pour passer le temps. A plus.

Re,

Si la réponse à mon précédent post est oui, alors:

J'aimerais en plus ajouté à cette macro 2 actions à la toutes fin qui partirait à chaque fois de la ligne 3 et qui analyse chaque ligne où du contenu est présent :

- Ajouter une colonne en F, nommer en F2 "NBFTG", puis faire la somme pour chaque ligne des colonnes D+E. Exemple : F3=D3+E3

- Ajouter une colonne en I, nommer en I2 "NBFTG", puis faire la somme pour chaque ligne des colonnes G+H. Exemple : I3=G3+H3

Puis renommer C2 : "TEAM"

Cordialement,

Rechercher des sujets similaires à "traitement extract"