Tableau données

Bonjour à tous,

j'espère que vous vous portez bien

Je viens à vous car j'aimerai créer une macro qui s'applique à toutes les feuilles du classeur que j'aurai sélectionné préalablement.

J'ai mis les instructions dans le PDF en pièces-jointes.

Je vous remercie par avance pour votre temps et je suis disponible pour vous répondre.

Bon après-midi à tous !

Laplacea

Bonjour

Une solution PowerQuery, intégré à Excel 2016+, en quelques clics sans VBA

Reste à supprimer la requête (mais en conservant le résultat) et les colonnes initiales mais j'ai laissé la requête pour que tu vois comment faire

Hello 78chris,

Je te remercie pour le temps que tu as consacré !

J'aime beaucoup ta solution. Néanmoins j'aurai vraiment besoin du code VBA pour réaliser ce process car je retraite par la suite ces données. J'ai besoin que la macro parte du même point d'arrivée arrive à la même finalité que j'ai pu transposer dans le PDF.

Est-ce que tu serais comment retranscrire ma demande en code VBA ?

Je te remercie par avance 78chris.

Je te souhaite un bon après-midi.

Laplacea

Salut à toi Klin89,

Je n'ai pas compris ton message.

Laplacea

Bonsoir à tous,

Quelqu'un aurait-il une solution s'il vous plait ?

Je vous souhaite à tous une bonne soirée et je vous remercie par avance de votre temps.

Laplacea

Bonjour Laplacea, 78chris, Klin89, le forum,

Un essai par macro.... ....pas sûr du résultat....

  • Tu selectionnes tes onglets
  • CTRL + e pour l'exécution

Cordialement,

Hello xorsankukai,

J'espère que tu vas bien.

La macro que tu proposes fonctionne parfaitement. Je t'en remercie !

Serait-il possible d'ajouter dans la macro un filtre dans la colonne "Hteam" où l'on classerait les données par ordre alphabétique ?

Je te remercie par avance de ton retour et merci pour cette macro !

Laplacea

Bonjour Laplacea, le forum,

Merci pour ton retour,

Serait-il possible d'ajouter dans la macro un filtre dans la colonne "Hteam" où l'on classerait les données par ordre alphabétique ?

c'est déjà le cas...

Tri les données de la colonne M du plus petit au plus grand, puis tri les données de la
colonne N dans l’ordre alphabétique
.Range("B3:G" & .Range("B" & Rows.Count).End(xlUp).Row).Sort .Range("B3"), xlAscending, .Range("C3"), , xlAscending

Je trie d'abord la colonne TEAM du plus petit au plus grand puis la colonne H team par ordre alphabétique.

Peut-être préfères-tu l'inverse ?

.Range("B3:G" & .Range("B" & Rows.Count).End(xlUp).Row).Sort .Range("C3"), xlAscending, .Range("B3"), , xlAscending

Cordialement,

Hello xorsankukai,

Merci pour ton retour et pour le temps que tu m'as accordé avec cette macro. Ca fonctionne super bien avec ce changement.

Tu gères comme d'habitude.

Prends soin de toi xorsankukai !

Laplacea

Hello Xorsankukai, le forum,

(Oui c'est encore moi )

J'ai remarqué une erreur macro par rapport au commandes demandées dans le PDF, j'aurai du m'en rendre compte immédiatement.

Je te renvoie en PDF les instructions surlignées en jaune pour ce qui pose un problème.

Je vais prendre un exemple concret avec le dernier Excel que tu as envoyé.

rencontre

J'ai sélectionné la première rencontre dans la feuille "18-19", celle la plus à gauche.

Ici, nous avons l'AEK qui gagne 2-0 contre Giannina à la fin du match. Également, l'AEK a mené 1-0 à la mi-temps.

Et le souci est le suivant après le traitement de la macro :

aek

Ce traitement est bon, aucun soucis car l'AEK a bien gagné 2-0 et a mené 1-0 à la mi-temps.

gianimijia

En revanche, ici c'est faux. Car dans les prochaines macros, on va considérer que Giannina a gagné 2-0 et a mené 1-0 à la mi-temps. Ce qui est l'inverse comme tu l'as bien compris.

Ainsi pour le traitement de Giannina, il faudrait mettre en colonne D, le score de droite soit un 0, en colonne E, le résultat de son adversaire soit 2, en F le résultat de Giannina la mi-temps présent en colonne I, et enfin G le résultat de l'AEK à la mi-temps, soit 1.

Ce que je suggérais dans les instructions en PDF permettent d'obtenir ce résultat. Après je ne doute pas qu'il existe d'autres possibilités.

Je te remercie par avance pour ton aide Xorsankukai et je te souhaite un bon début de week-end !

Adrien

Salut Adrien,

Bonjour le forum,

Comme je te le disais, je me mélange les pinceaux, j'ai du mal à m'y retrouver.....

Toutefois, je crois que j'ai trouver mon erreur....du moins je l'espère...

            tabloS(3, k + 1) = tablo(i, 5)     ' c'est 6
            tabloS(4, k + 1) = tablo(i, 6)     ' c'est 5
            tabloS(5, k + 1) = tablo(i, 7)     ' c'est 8
            tabloS(6, k + 1) = tablo(i, 8)     ' c'est 7

Correctif:

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, 6)
            tabloS(4, k + 1) = tablo(i, 5)
            tabloS(5, k + 1) = tablo(i, 8)
            tabloS(6, k + 1) = 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") = "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
capture capture2

Cordialement,

Hello Xorsankukai, le forum,

Je te remercie pour ton retour.

Génial, ta correction complète le problème.

Sauf que maintenant je n'ai plus les colonnes NBFTG en colonne F (somme de la colonne D + E) & NBHTG (somme des colonnes en G + H)en colonne I, comme tu peux le voir dans le comparatif des images ci-dessous.

(ancienne macro)

nbftg

(nouvelle macro)

sans nbftg

Est-ce que tu peux ajouter le code pour ces 2 colonnes stp ?

Je te remercie par avance et passes une bonne soirée !

Laplacea

Salut Adrien,

Bonjour le forum,

A tester....

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, 6)
            tabloS(4, k + 1) = tablo(i, 5)
            tabloS(5, k + 1) = tablo(i, 8)
            tabloS(6, k + 1) = 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") = "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
       .Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("F2") = "NBFTG": .Range("F2").Font.Bold = True
    .Range("F3").Formula = "=SUM(D3:E3)"
    .Range("F3").AutoFill Destination:=.Range("F3:F" & .Range("B" & Rows.Count).End(xlUp).Row)
    .Range("I2") = "NBHTG": .Range("I2").Font.Bold = True
    .Range("I3").Formula = "=SUM(G3:H3)"
    .Range("I3").AutoFill Destination:=.Range("I3:I" & .Range("B" & Rows.Count).End(xlUp).Row)
   End With

End Sub

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

Cordialement,

Hello Xorsankukai, le forum,

Je te remercie pour ton retour. Je te confirme que ça fonctionne super bien !

Merci beaucoup je te souhaite un bon week-end et prends soin de toi !

Laplacea

Rechercher des sujets similaires à "tableau donnees"