Résumé toutes les informations d'un tableau

[Aimedjie]

Bonjour,

J'ai un tableau avec des données et je voudrais que ce tableau soit résumé sous forme de liste dans une autre feuille. Est-ce possible?

J'ai ajouté des noms de cellules et le nom des feuilles afin de simplifier l'écriture des macros et de m'assurer que peu importe ce qui se passera les macros fonctionneront toujours. De plus, pourriez-vous mettre beaucoup de commentaires dans les macros, le cas échéant, pour que je puisse les comprendre?

Donc, dans l'onglet "Tableau", il y a divers chiffres qui peuvent être appelés à être modifiés. Par contre, les cellules noires n'auront jamais d'écriture. Ainsi, en fonction de tous les chiffres de l'onglet "Tableau", je veux générer la liste qui se trouve dans l'onglet "Liste".

Dans l'onglet "Liste", je veux que la liste soit exactement comme celle que j'ai fait manuellement. Donc, il faut commencer par identifier la colonne de l'onglet "Tableau" et ensuite, à chaque fois qu'il y a un chiffre dans cette colonne, il faut lire le chiffre et le titre de la ligne. S'il y a plusieurs chiffres dans une même colonne, il faut les inscrire sur différentes lignes dans l'onglet "Liste". Et lorsqu'on passe à la colonne suivante de l'onglet "Tableau", on doit laisser une ligne vide afin de bien identifier chaque entête de colonne de l'onglet "Tableau".

J'espère être clair, mais surtout, que vous trouverez une solution!

Merci!

 

[ROGER2327]

Re : Résumé toutes les informations d'un tableau

Bonjour Aimedjie.

Un essai dans le classeur joint avec ce code :​

Sub toto()
Dim i%, j%, k&, l%, Cat1&(), Dat(), x(), tf As Boolean

  wksTableau.Cells(1, 1).Select
  Dat = wksTableau.Cells(2, 2).Resize(26, 25).Value
  wksListe.Cells.Clear

  For j = 2 To UBound(Dat, 2)
    ReDim Cat1(0 To UBound(Dat, 1) - 1)
    For i = 2 To UBound(Dat, 1)
      If Not IsEmpty(Dat(i, j)) And IsNumeric(Dat(i, j)) And 0 <> Dat(i, j) Then
        Cat1(0) = Dat(i, j) + Cat1(0)
        Cat1(i - 1) = Dat(i, j)
      End If
    Next
    tf = True
    If Cat1(0) Then
      For l = 1 To UBound(Cat1, 1)
        If Not IsEmpty(Cat1(l)) And 0 <> Cat1(l) Then
          k = k + 1
          x = Array(IIf(tf, "Dans la catégorie", ""), IIf(tf, Dat(1, j), Empty), _
          IIf(tf, "il y aura", Empty), IIf(tf, Cat1(0), Empty), _
          IIf(tf, IIf(Cat1(0) > 1, "joueurs affiliés", "joueur affilié") & " dont", Empty), Cat1(l), _
          IIf(Cat1(l) > 1, "proviennent", "provient") & " de la catégorie", Dat(l + 1, 1))
          wksListe.Cells(k, 1).Resize(, UBound(x) + 1).Value = x
          tf = False
        End If
      Next
    End If
    k = k - Not tf
  Next

wksListe.Columns("A:H").EntireColumn.AutoFit
wksListe.Activate

End Sub

ROGER2327
#6846

Jeudi 19 Absolu 141 (Sainte Grues, ophiophiles - fête Suprême Quarte)
5 Vendémiaire An CCXXII, 7,2762h - cheval
2013-W39-4T17:27:46Z

 

[Aimedjie]

Re : Résumé toutes les informations d'un tableau

WOW!!!!!!!!!!!!! Ça marche! Merci, mais est-ce possible d'avoir des explications parce que ça marche.... mais je ne comprends rien. Si je veux ajouter un autre tableau pour y mettre autre chose et l'insérer dans ma liste, je fais comment.

 

[ROGER2327]

Re : Résumé toutes les informations d'un tableau

Re...

WOW!!!!!!!!!!!!! Ça marche! (...)

Tant mieux !


​

(...) mais est-ce possible d'avoir des explications parce que ça marche.... mais je ne comprends rien. (...)

Le code a été écrit à la va vite comme un essai. Il est inutilement compliqué (pourquoi tant de boucles !), et même un peu farfelu.

Un exemple parmi d'autres,

        If 0 <> Cat1(l) Then

au lieu de

        If Not IsEmpty(Cat1(l)) And 0 <> Cat1(l) Then

aurait suffi.

Voici une version plus simple et plus rapide pour obtenir le même résultat :
​

Sub toto()
Dim i%, j%, k%, l%, c&, LDat(), CDat(), Dat()

Rem * Ligne cosmétique. Peut-être supprimée sans inconvénient.
  With wksTableau: .Activate: .Cells(1, 1).Select: End With

Rem * Localisation des données
  With wksTableau.[B2:Z27]
Rem * Les intitulés de champs (= première ligne de données) sont chargées dans le tableau LDat.
    LDat = Intersect(.Rows(1), .Offset(0, 1).Rows(1)).Value
Rem * Les intitulés dʼenregistrements (= première colonne de données) sont chargées dans le tableau CDat.
    CDat = Intersect(.Columns(1), .Offset(1, 0).Columns(1)).Value
Rem * Les données sont chargées dans le tableau Dat.
    Dat = Intersect(.Cells, .Offset(1, 1)).Value
  End With

'=====================================================
Rem * Les variables "k", "l" sont des variables techniques décrivant la structure de la plage de résultats.
Rem * Les résultats sont écrits par blocs séparés par une ligne vide.
Rem * Dans chaque bloc, "l" compte le nombre de lignes du bloc courant.
Rem * "k" compte le nombre global de lignes écrites.
Rem * La variable "c" cumule les données de la sixième colonne du bloc courant. (Sa valeur apparaît dans la quatrième colonne.)
'=====================================================

Rem * Définition de la feuille de résultats.
  With wksListe

Rem * Effacement de la feuille. (Doit être modifié sʼil faut garder certains éléments de la feuille de résultats.)
    .Cells.Clear

Rem * Définition de lʼemplacement des résultats dans la feuille. Peut être modifiée à volonté.
    With .[A1]

Rem * Lecture des données colonne par colonne.
      For j = 1 To UBound(Dat, 2)
        l = 0
Rem * Lecture des données ligne par ligne dans la colonne courante (= colonne j).
        For i = 1 To UBound(Dat, 1)
Rem * Vérification de la validité de la donnée de la ligne courante (= ligne i) dans la colonne courante.
          If Not IsEmpty(Dat(i, j)) And IsNumeric(Dat(i, j)) And 0 <> Dat(i, j) Then
            If l = 0 Then k = k + 1: c = 0
            c = c + Dat(i, j)
Rem * Écriture dans les colonnes 6 à 8 de la plage de résultats.
            .Offset(k + l - 1, 5).Resize(, 3) = Array(Dat(i, j), IIf(Dat(i, j) > 1, "proviennent", "provient") & " de la catégorie", CDat(i, 1))
            l = l + 1
          End If
        Next
        If Not l = 0 Then
Rem * Écriture dans les colonnes 1 à 5 de la plage de résultats.
          .Offset(k - 1, 0).Resize(, 5) = Array("Dans la catégorie", LDat(1, j), "il y aura", c, IIf(c > 1, "joueurs affiliés", "joueur affilié") & " dont")
          k = k + l
        End If
      Next

Rem * Ligne cosmétique.
      .Parent.Columns(.Column).Resize(, 8).EntireColumn.AutoFit

    End With

Rem * Ligne cosmétique. Peut-être supprimée sans inconvénient.
    .Activate

  End With

End Sub

C'est plus lisible sans commentaire !​

Sub toto()
Dim i%, j%, k%, l%, c&, LDat(), CDat(), Dat()

  With wksTableau: .Activate: .Cells(1, 1).Select: End With

  With wksTableau.[B2:Z27]
    LDat = Intersect(.Rows(1), .Offset(0, 1).Rows(1)).Value
    CDat = Intersect(.Columns(1), .Offset(1, 0).Columns(1)).Value
    Dat = Intersect(.Cells, .Offset(1, 1)).Value
  End With

  With wksListe

    .Cells.Clear

    With .[A1]

      For j = 1 To UBound(Dat, 2)
        l = 0
        For i = 1 To UBound(Dat, 1)
          If Not IsEmpty(Dat(i, j)) And IsNumeric(Dat(i, j)) And 0 <> Dat(i, j) Then
            If l = 0 Then k = k + 1: c = 0
            c = c + Dat(i, j)
            .Offset(k + l - 1, 5).Resize(, 3) = Array(Dat(i, j), IIf(Dat(i, j) > 1, "proviennent", "provient") & " de la catégorie", CDat(i, 1))
            l = l + 1
          End If
        Next
        If Not l = 0 Then
          .Offset(k - 1, 0).Resize(, 5) = Array("Dans la catégorie", LDat(1, j), "il y aura", c, IIf(c > 1, "joueurs affiliés", "joueur affilié") & " dont")
          k = k + l
        End If
      Next

      .Parent.Columns(.Column).Resize(, 8).EntireColumn.AutoFit

    End With

    .Activate

  End With

End Sub

(...) Si je veux ajouter un autre tableau pour y mettre autre chose et l'insérer dans ma liste, je fais comment.

La demande est beaucoup trop vague : Je ne sais pas.​

ROGER2327
#6847

Vendredi 20 Absolu 141 (Sainte Mélusine, souillarde de cuisine - fête Suprême Quarte)
6 Vendémiaire An CCXXII, 6,2833h - balsamine
2013-W39-5T15:04:48Z