Créer un tableau en fonction d'un autre tableau

Bonjour,

Je viens vers vous car j'aimerai réarranger un tableau afin de pouvoir aller en sortir des données facilement.

Par exemple j'aimerai dans le cas présent remplir mon tableau dans l'onglet récap en allant chercher les données dans le tableau "Vis tete hexagonale" de l'onglet VIS tete H.

J aimerai remplir dans l'onglet recap donc la colonne composant en écrivant H screw, la colonne matière par acier, l'onglet diamètre par le diamètre de la vis (ex: M4, M5, M6, etc..), la colonne longueur par sa longueur et la colonne code par le code correspondant si il y en a un.

Je suis débutant en VBA et j'ai aucune idées de comment m'y prendre donc ca serait avec plaisir que j'accepterai votre aide si possible !

Merci d'avance !

Bonjour,

C'est un sujet pour PowerQuery, curieux que personne ne se soit jeté dessus.

Voici ma version plus classique VBA

Option Base 1
Sub rafraichir()
    Worksheets("Recap").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    tablo ("A25")
    tablo ("A59")
    tablo ("A86")
End Sub
Sub tablo(r)
Dim f As Worksheet, rng As Range, resultat()
    Set f = Worksheets("Vis Tete H")

    Set rng = f.Range(r).CurrentRegion
    tbl = rng.Value
    matiere = Split(tbl(1, 1), Chr(10))(0)
    ReDim resultat(UBound(tbl) * UBound(tbl, 2), 5)
    k = 1
    For i = 3 To UBound(tbl, 2)
        For j = 5 To UBound(tbl)
            resultat(k, 1) = "H screw"
            resultat(k, 2) = matiere
            resultat(k, 3) = tbl(1, i)
            resultat(k, 4) = tbl(j, 2)
            resultat(k, 5) = tbl(j, i)
            k = k + 1
        Next
    Next
    Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(resultat), UBound(resultat, 2)) = resultat

End Sub

Encore un grand merci Steelson !!!!

SI c'est pas trop demander, pourrais tu me mettre juste quelques explications à partir de ligne ReDim car je galère à tout comprendre ahah ! :)

Bonjour,

Hey Steelson, ça fait plaisir de te voir dans le coin ;)

J'avais commencé à regarder un peu hier, et j'avais été embêté (comme toi du reste) avec les lignes fusionnées, qui engendraient des cellules vides dans le rendu. À postériori et en voyant ton code, on doit pouvoir bidouiller ainsi :

For i = 3 To UBound(tbl, 2)
        For j = 5 To UBound(tbl)
            resultat(k, 1) = "H screw"
            resultat(k, 2) = matiere
            resultat(k, 3) = tbl(1, i)
        If tbl(j, 2) <> "" Then
            resultat(k, 4) = tbl(j, 2)
        Else: resultat(k, 4) = tbl(j - 1, 2)
        End If

@JoyeuxNoël ... oui on m'a sollicité, sinon je ne joue plus à excel ! et puis les PQweryPuristes n'ont pas donné signe de vie ;à-dessus, le forum excel serait-il en léthargie ?

Tu proposes un j-1, moi je mettrais plutôt une valeur mémoire, la dernière trouvée, que j'appellerais si jamais il y avait 3 cellules fusionnées, mais j'ai préféré juste signaler le problème dans le fichier. Sinon, quelque chose comme ceci :

    k = 1
    der = ""
    For i = 3 To UBound(tbl, 2)
        For j = 5 To UBound(tbl)
            resultat(k, 1) = "H screw"
            resultat(k, 2) = matiere
            resultat(k, 3) = tbl(1, i)
            if (tbl(j, 2) <> "") then 
                der = tbl(j, 2)
            end if
            resultat(k, 4) = der
            resultat(k, 5) = tbl(j, i)
            k = k + 1
        Next
    Next

@GomJu

voici quelques explications

' j'aurais pu ici redimensionner à chaque donnée prélevée du tableau maître, mais cela aurait obligé à travailler en transposé car on ne peut ajouter une ligne que sur le dernier indice d'un tableau - j'ai pris large en mettant un nombre de lignes égal au nombre de cases du tableau sachant même que je ne prends pas les 2 premières colonnes et les 5 premières lignes ... pour être homogène, regarde bien que sur le laiton j'ai ajouté une ligne fictive
    ReDim resultat(UBound(tbl) * UBound(tbl, 2), 5)

' k sera la ligne du tableau
    k = 1

' je balaie ici les lignes et colonnes du tableau maître
    For i = 3 To UBound(tbl, 2)
        For j = 5 To UBound(tbl)

' j'affecte ici au résultat les valeurs comme demandées
            resultat(k, 1) = "H screw"
            resultat(k, 2) = matiere
' en ligne 1
            resultat(k, 3) = tbl(1, i)
' en colonne 2
            resultat(k, 4) = tbl(j, 2)
' le code
            resultat(k, 5) = tbl(j, i)
            k = k + 1
        Next
    Next

' in du tableau, je le colle dans la feuille récap
    Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(resultat), UBound(resultat, 2)) = resultat

T'es vraiment le boss !!!! Merci infiniment !!!! :)

Steelson a écrit :

@JoyeuxNoël ... oui on m'a sollicité, sinon je ne joue plus à excel ! et puis les PQweryPuristes n'ont pas donné signe de vie ;à-dessus, le forum excel serait-il en léthargie ?

Je ne sais pas trop. Je me connecte beaucoup moins et suis moins motivé depuis longtemps déjà. Il en est peut-être de même pour d'autres. Et la relève tarde à arriver.

Steelson a écrit :

Tu proposes un j-1, moi je mettrais plutôt une valeur mémoire, la dernière trouvée, que j'appellerais si jamais il y avait 3 cellules fusionnées, mais j'ai préféré juste signaler le problème dans le fichier.

Ah oui, exact. Je pensais que ça fonctionnerait même avec plus, mais non.... Merci pour la précision !

@Gomju,

D'ailleurs, te rends-tu compte que tu es venu demander en PV à pas mal de personnes d'intervenir sur le sujet, et que la macro proposée sera obsolète quand tu auras regroupé tes tableaux en un seul, comme tu sembles vouloir le faire ??

J'ai demandé seulement à vous deux :)

Après c'est mon but d'avoir un seul tableau comme cela, j'avais déjà réussi à créer un code après pour pouvoir gérer une nomenclature automatique, sauf que la je voulais la mettre en corrélation avec un fichier de notre boite !

Je vais m'inspirer de ce que m'a donné Steelson pour pouvoir regrouper également mes autres pages de visseries mais je pense que ca devrait le faire !

C'était quoi tes craintes par rapport à la macro ?

Et merci également à toi pour le temps que tu as passé pour m'aider, c'est vraiment gentils et je m'attendais pas à recevoir autant d'aide sur ce forum pour être honnête !

JoyeuxNoel a écrit :

Steelson a écrit :

@JoyeuxNoël ... oui on m'a sollicité, sinon je ne joue plus à excel ! et puis les PQweryPuristes n'ont pas donné signe de vie ;à-dessus, le forum excel serait-il en léthargie ?

Je ne sais pas trop. Je me connecte beaucoup moins et suis moins motivé depuis longtemps déjà. Il en est peut-être de même pour d'autres. Et la relève tarde à arriver.

en fait, je suis à fond sur GSheets que j'apprécie pour ses formules (query, transpose, filter, unique, arrayformula etc.) et ses scripts basés sur du javascript; la manipulation des json est presque un jeu d'enfants !

Re,

J'ai essayé de pimper un peu le programme que tu m'as fait afin de pouvoir detecter automatiquement le debut d'un tableau au cas ou on rajouterai des ligne, ce qui aurait pu décaler le début du tableau 2 et 3. Mais j'ai un problème.

Sub rafraichir()

Dim LigneVisHAcier As Integer
Dim LigneVisHInox As Integer
Dim LigneVisHLaiton As Integer
Dim ColonneVisHAcier As Integer
Dim ColonneVisHInox As Integer
Dim ColonneVisHLaiton As Integer
Dim XHAcier As String
Dim XHInox As String
Dim XHLait As String

LigneVisHAcier = Sheets("Vis Tete H").Range("TableauVisHAcier").Row
LigneVisHInox = Sheets("Vis Tete H").Range("TableauVisHInox").Row
LigneVisHLaiton = Sheets("Vis Tete H").Range("TableauVisHLaiton").Row
ColonneVisHAcier = Sheets("Vis Tete H").Range("TableauVisHAcier").Column
ColonneVisHInox = Sheets("Vis Tete H").Range("TableauVisHInox").Column
ColonneVisHLaiton = Sheets("Vis Tete H").Range("TableauVisHLaiton").Column

XHAcier = Cells(LigneVisHAcier, ColonneVisHAcier).Address
XHInox = Cells(LigneVisHInox, ColonneVisHInox).Address
XHLait = Cells(LigneVisHLaiton, ColonneVisHLaiton).Address

Worksheets("Recap").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
tablo ("XHAcier")

Le programme dans la fonction bloque ensuite au niveau de Set rng = f.Range(r).CurrentRegion

Une idée ? :)

Désolé mon code doit pas être bien propre à vos yeux ahah :)

C'est bon j'ai réussi je vous embette pas plus :)

Re bonjour messieurs !

J'ai une petite question !

J'ai essayé de transposer ce code dans un autre fichier du coup, car le fichier que je vous ai envoyé la dernière fois était une version allégé. Et lorsque j'exécute le code, j'ai le problème que j'ai un décalage de une colonne vers la droite de mon tableau et également que je suis une ligne plus bas. J'ai essayé de corriger ça de plusieurs facon mais dans le meilleur des cas je me retrouve avec mes entêtes effacées.

Avez vous une petite idées de ce qu'il faudrait faire ? C'est trop bizare car bien que j'ai fais quelques modifs sur le code, hier ça marchait très bien sur l'autre fichier.

Cela ne fonctionne pas si tu as plusieurs cellules fusionnées, plus de 2,

        If tbl(j, 2) <> "" Then
            resultat(k, 4) = tbl(j, 2)
        Else: resultat(k, 4) = tbl(j - 1, 2)

donc ce n'est pas propre, ou bien tu t'arranges à ce qu'il n'y ait pas de cellules fusionnées ou bien tu prends ma proposition.

Je viens de tester avec at solution mais ca enlève pas le fait que ca me créé une ligne entre mes deux tableau et que ca me supprime l'entête :'(

C'est trop bizarre pcq ca me le faisait pas sur ton fichier. Si t'as une idée je suis preneur ! :)

J'ai trouvé comment supprimer la ligne être les tableaux en mettant la fonction ci dessous la fonction rafraichir. Il me reste plus que le problème de suppression des entêtes si t'as une idée ! Après dans le pire des cas je les écrirai dans la fonction rafraichir pour les faire apparaitre à chaque fois. Si t'as une autre solution je suis heureux :)

Range("A2:A65000").SpecialCells(xlCellTypeBlanks).EntireRow.Dele

pas très joli de mettre 65000, il faut mettre rows.count

en tous cas la raison est que tu n'as pas mis

Option Base 1

tu peux globalement simplifier ta macro comme suit

Option Base 1
Sub rafraichir()

    Worksheets("Base données").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    tablo "TableauVisHAcier", 5
    tablo "TableauVisHInox", 5
    tablo "TableauVisHLaiton", 4

End Sub
Sub tablo(rng As String, depuis As Integer)
Dim f As Worksheet, resultat()
    Set f = Worksheets("Vis tête H")
    tbl = Range(rng).Value
    matiere = Split(tbl(1, 1), Chr(10))(0)
    ReDim resultat(UBound(tbl) * UBound(tbl, 2), 5)
    k = 1
    d = ""
    For i = 3 To UBound(tbl, 2)
        For j = depuis To UBound(tbl)
            resultat(k, 1) = "H screw"
            resultat(k, 2) = matiere
            resultat(k, 3) = tbl(1, i)
            If tbl(j, 2) <> "" Then
                d = tbl(j, 2)
            End If
            resultat(k, 4) = d
            resultat(k, 5) = tbl(j, i)
            k = k + 1
        Next
    Next
    Worksheets("Base données").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(resultat), UBound(resultat, 2)) = resultat
End Sub

après, je n'ai pas compris tes colonnes

Merci merci tout marche ! :)

Je vais remettre en forme mais infiniment merci !