Résolu Créer un Tableau automatiquement à partir d'un autre.

Pickis

XLDnaute Nouveau
Bonjour, je voulais savoir si il était possible de créer un Tableau automatiquement a partir d'un tableau qui lui servirai de référence.
En gros dans mon tableau de base j'ai 2 colonne. 1 pour le nombre d'élèves. 2 pour le nom de la classe :
Tableau Référent.
Visu1.png
Je voudrais que ça me génére un tableau comme ça :
Tableau Automatique
Visu2.png etc..
Le Tableau Automatique va générer 28 ligne de 6°7, 29 de 6°6 et 27 de 6°5. Et dans la colonne N°, le nombre total d'élèves.
Mon fichier d'exemple en pièce jointe et fait sous Numbers (Mac) mais je peux aussi travailler sous PC.
Ca vous permet d'avoir un visuel mais il y a aucune formule c'est juste pour vous donner une idée.
Cordialement
Pickis
 

Fichiers joints

Robert

XLDnaute Barbatruc
Bonjour Pickis, bonjour le forum,

Peut-être comme ça :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NE As Integer 'déclare la variable NE (Nombre d'Élèves)
Dim CL As String 'déclare la variable CL (Classe)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set OS = Worksheets("Feuille 1") 'définit l'onglet source OS
Set OD = Worksheets("Tableau Automatique") 'définit l'onglet destination OD
OD.Range("A1").CurrentRegion.ClearContents 'efface les anciennes valeurs de l'onglet destination
OD.Range("A1").Value = "N°" 'écrit en A1
OD.Range("B1").Value = "Classe" 'écrit en B1
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) - 1 'boucle sur toutes les ligne I du tableau des valeurs (de la seconde à l'avant dernière)
    NE = TV(I, 1) 'définit le nombre d'élève NE
    CL = TV(I, 2) 'définit la classe CL
    LI = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row + 1 'définit la première ligne vide LI de la colonne B de l'onglet OD
    'renvoie la classe CL dans la cellule ligne LI colonne B redimensionnée à NE lignes et 1 colonne
    OD.Cells(LI, "B").Resize(NE, 1).Value = CL
Next I 'prochaine valeur de la boucle
LI = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row - 1 'redéfinit la ligne LI
With OD.Cells(2, "A") 'prend en compte la cellule A2
    .Value = 1 'écrit 1 en A2
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Stop:=LI, Trend:=False ' créé une serie en colonne de type linéaire par pas de 1 de 1 à LI
End With
End Sub
 

Pickis

XLDnaute Nouveau
Super je regarde ca.
Maintenant comme je suis néophyte, je dois copier ou rentrer ton petit programme ou pour que cela fonctionne.
 

Robert

XLDnaute Barbatruc
Bonjour le fil, bonjour le forum,

Prend celui de François (que je salue au passage), il est déjà tout copié...
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil,

Un autre possibilité (avec Tableau => Array, mais pas tout à fait comme Robert)
VB:
Sub RecopieTableaux()
Dim a, c, i&, j&, k&
a = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)
k = Application.Sum(Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row))
ReDim c(1 To k, 1 To 2)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 1) <> "" Or a(i, 1) <> 0 Then
    For k = 1 To a(i, 1)
      j = j + 1
      c(j, 1) = k: c(j, 2) = a(i, 2)
    Next k
  End If
Next i
'ici pour changer la localisation du nouveau tableau
Columns("D:E").ClearContents
[D1:E1] = Array("N°", "Classe")
[D2].Resize(UBound(c, 1), UBound(c, 2)) = c
Columns("D:E").AutoFit
End Sub
NB: Ici, le tableau est récréé en colonnes DE
Donc adapter dans le code selon besoin.
 

Pickis

XLDnaute Nouveau
Merci pour vos nombreuses réponses. Je suis en train de tester toutes vos solutions, et surtout d'essayer de comprendre comment une commande Macro fonctionne.
Encore Merci vs êtes top, je dirais même des fous Furieux !
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

[Petite précision]
Mon code fonctionnera si le tableau de base est identique à celui-ci
01_tab.jpg
NB: On ne doit pas avoir de Totaux sur le dernière ligne
(comme dans ton fichier exemple)
 

job75

XLDnaute Barbatruc
Bonsoir Pickis, fanfan38, Robert, JM,

Puisque le nombre de classes n'est jamais très élevé (quelques dizaines) il n'est pas nécessaire d'utiliser des tableaux VBA.

Même Application.ScreenUpdating = False est inutile, voyez cette macro dans le code de la dernière feuille du fichier joint :
VB:
Private Sub Worksheet_Activate()
Dim deb As Range, h&, c As Range
Set deb = [A2] '1ère cellule à remplir, à adapter éventuellement
With Sheets("Feuille 1").[A:A] 'nom de la feuille à adapter
    h = Application.SumIf(.Cells, ">0", .Cells) 'SOMME.SI
    If h Then
        deb = 1: deb.Resize(h).DataSeries 'numérotation
        deb.Resize(h, 2).Borders.Weight = xlThin 'bordures
        With .SpecialCells(xlCellTypeConstants, 1)
            For Each c In .Cells
                If c > 0 Then deb(1, 2).Resize(c) = c(1, 2): Set deb = deb.Offset(c)
            Next
        End With
    End If
End With
deb.Resize(Rows.Count - deb.Row + 1, 2).Delete xlUp 'RAZ en dessous
End Sub
Elle se déclenche automatiquement quand on active la feuille.

Nota : la ligne du Total en Feuille 1 n'a aucune importance.

A+
 

Fichiers joints

chris

XLDnaute Barbatruc
Bonjour à tous

Une contribution avec PowerQuery intégré à 2019 PC.

Actualiser par Données Actualiser tout (ou ThisWorkbook.RefreshAll)
 

Fichiers joints

Pickis

XLDnaute Nouveau
Bonsoir Pickis, fanfan38, Robert, JM,

Puisque le nombre de classes n'est jamais très élevé (quelques dizaines) il n'est pas nécessaire d'utiliser des tableaux VBA.

Même Application.ScreenUpdating = False est inutile, voyez cette macro dans le code de la dernière feuille du fichier joint :
VB:
Private Sub Worksheet_Activate()
Dim deb As Range, h&, c As Range
Set deb = [A2] '1ère cellule à remplir, à adapter éventuellement
With Sheets("Feuille 1").[A:A] 'nom de la feuille à adapter
    h = Application.SumIf(.Cells, ">0", .Cells) 'SOMME.SI
    If h Then
        deb = 1: deb.Resize(h).DataSeries 'numérotation
        deb.Resize(h, 2).Borders.Weight = xlThin 'bordures
        With .SpecialCells(xlCellTypeConstants, 1)
            For Each c In .Cells
                If c > 0 Then deb(1, 2).Resize(c) = c(1, 2): Set deb = deb.Offset(c)
            Next
        End With
    End If
End With
deb.Resize(Rows.Count - deb.Row + 1, 2).Delete xlUp 'RAZ en dessous
End Sub
Elle se déclenche automatiquement quand on active la feuille.

Nota : la ligne du Total en Feuille 1 n'a aucune importance.

A+
Super et merci pour la réponse, avec mon tout petit niveau j ai reussi a rajouter 2 p'tit trucs a ton code en ligne 13,14,15
VB:
Private Sub Worksheet_Activate()
Dim deb As Range, h&, c As Range
Set deb = [A2] '1ère cellule à remplir, à adapter éventuellement
With Sheets("Feuille 1").[A:A] 'nom de la feuille à adapter
    h = Application.SumIf(.Cells, ">0", .Cells) 'SOMME.SI
    If h Then
        deb = 1: deb.Resize(h).DataSeries        'numérotation
        deb.Resize(h, 2).Borders.Weight = xlThin 'bordures
        With .SpecialCells(xlCellTypeConstants, 1)
            For Each c In .Cells
                If c > 0 Then deb(1, 2).Resize(c) = c(1, 2): Set deb = deb.Offset(c)
                Range("C1").Select
    ActiveCell.FormulaR1C1 = "Indiv"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]&"".jpg"""
            Next
        End With
    End If
End With
deb.Resize(Rows.Count - deb.Row + 1, 2).Delete xlUp    'RAZ en dessous
End Sub
Mes soucis :
1/ je voudrais que la formule de ma colonne "Indiv" s'ajuste automatiquement a mon tableau.

2/ Colonne A il me faut une numérotation avec au moins 3 ou 4 zéros devant mon chiffre Ex-0001 (J'ai trouvé comment faire dans excel),
par contre dans ma nouvelle Colonne Indiv Il veut pas me prendre cette numérotation avec 3 ou 4 zéros devant mon chiffre, pourtant cette dernière se structure avec les valeurs de la colonne A.
J'espère avoir été clair
Cordialement
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Pickis, chris, le forum,

Fichier (2), ici j'ai quand même ajouté Application.ScreenUpdating = False :
VB:
Private Sub Worksheet_Activate()
Dim deb As Range, h&, c As Range
Set deb = [A2] '1ère cellule à remplir, à adapter éventuellement
With Sheets("Feuille 1").[A:A] 'nom de la feuille à adapter
    h = Application.SumIf(.Cells, ">=1", .Cells) 'SOMME.SI
    If h Then
        Application.ScreenUpdating = False 'fige l'écran
        deb = 1: deb.Resize(h).DataSeries 'numérotation
        deb.Resize(h, 3).Borders.Weight = xlThin 'bordures
        For Each c In .SpecialCells(xlCellTypeConstants, 1)
            If c >= 1 Then deb(1, 2).Resize(c) = c(1, 2): _
                deb(1, 3).Resize(c) = "=TEXT(RC[-2],""0000.\j\p\g"")": Set deb = deb.Offset(c)
        Next
    End If
End With
deb.Resize(Rows.Count - deb.Row + 1, 3).Delete xlUp 'RAZ en dessous
End Sub
Edit 1 : >=1 va mieux que > 0.

Edit 2 : chris sur ton fichier la numérotation en colonne E n'est pas ce qui est demandé.

Bonne journée.
 

Fichiers joints

Dernière édition:

Pickis

XLDnaute Nouveau
Super Merci à tous, le Post est clos grâce à vos réponses la dernière de Job75 répond en tout point a ce que j'avais besoin.
Mille merci, RDV pour d'autre demande...qui vont pas tarder.;)
 

chris

XLDnaute Barbatruc
RE
Edit 2 : chris sur ton fichier la numérotation en colonne E n'est pas ce qui est demandé.
[/QUOTE]
Effectivement :eek:
Facile à modifier.
En revanche la formule ajoutée dans une 3ème colonne, bien que possible, ne serait pas calculée automatiquement... par contre on peut mettre le résultat et non la formule...
 
Dernière édition:

chris

XLDnaute Barbatruc
RE
Mais voici une solution simple
Comme je l'ai dit je pouvais aisément modifier la numérotation mais la demande est maintenant d'insérer une formule dans une autre colonne (demande un peu curieuse puisqu'on peut insérer le résultat et je ne vois donc pas l'utilité de la formule).
J'arrive à le faire mais, dans le tableau résultant, la formule n'est pas calculée automatiquement , juste affichée et il faut faire une manip, manuelle ou VBA, pour que le calcul se fasse.
Si tu as une solution, je prends.
 

merinos

XLDnaute Occasionnel
@chris ,

C'est super simple: la table résultat est une table... & tu peux y adjoindre des colonnes qui ne sont pas le résultat du query.

J'ai ajouté une colonne qui calcule le prix TVA incl.

Merinos,

PS: J'employais cette methode avant d'arriver a faire passer des info via un tableau de parametres.
 

Fichiers joints

chris

XLDnaute Barbatruc
@merinos

Oui dans Excel je n'ai pas de souci.
La question était de créer la formule dans PQ
Comme dit, ici je ne vois pas l'intérêt...

Mais il n'y a pas longtemps il y a eu une demande pour créer un hyperlien par formule depuis PQ.
Avec Jean-Eric, on a trouvé une astuce sur le web mais soit elle ne marche que sur la version US, soit elle ne marche pas du tout car nous avons essayé chacun sans succès.
 

merinos

XLDnaute Occasionnel
@chris ,

Trouvé...

Etape 1= le query crée la formule AVEC une apostrophe devant
Etape 2: la colonne est formatée comme lien (visuel)

Etape 2: le refresh se fait avec une macro qui enlève l'apostrophe lors d'un refresh.
 

Fichiers joints

chris

XLDnaute Barbatruc
RE

Oui ne marche qu'avec VBA alors que le site qui donnait l'astuce disait que non...

On peut aussi sans l'apostrophe, sélectionner la colonne de formule, se placer dans la barre de formule puis CTRL entrée mais c'est manuel...

Merci du test en tout cas :):).
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas