XL 2010 Transformer un Tableau à double entrée en liste en VBA

B

Bichette001

XLDnaute Junior
Bonjour
j'ai un tableau avec 6 colonnes et en ligne des dates
je souhaiterai un code vba pour le transformer en liste
ex :
A B C D E
3/12/18 1 2 3 4 5
4/12/18 6 7 8 9 10

j'ai regardé le post du 21/2/13 mais je n'arrive pas à moduler pour fixer le nb de colonne qui ici est de 6

un grand merci pour votre aide

:) Bichette
 

Pièces jointes

  • Test Bichette.xlsx
    9 KB · Affichages: 30
Dernière édition:
Trier par date Trier par votes
B

Bichette001

XLDnaute Junior
vgendron à dit:
juste cette ligne
tabInit = .Range("A1:F" & fin).Value
qui devient
tabInit = .Range("A1:H" & fin).Value
Cliquez pour agrandir...




Bonjour Vgendron
j'ai un débogage ...il doit y avoir une coquille...?

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
fin = .Range("A" & .Rows.Count).End(xlUp).Row
tabInit = .Range("A1:H" & fin).Value
taille = (UBound(tabInit, 1) - 2) * UBound(tabInit, 2)
ReDim tabFinal(1 To taille, 1 To 3)
j = 1
For i = 2 To UBound(tabInit, 1)
For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2)
tabFinal(j, 1) = tabInit(i, 1) => débogage à cet endroit
tabFinal(j, 2) = tabInit(1, k)
tabFinal(j, 3) = tabInit(i, k)
j = j + 1
Next k

Next i
End With

With Sheets("RES")
.UsedRange.Offset(1, 0).Clear
.Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub
 
Vote positif 0 Vote négatif
B

Bichette001

XLDnaute Junior
vgendron à dit:
Hello tous !

avec ceci
VB: 
Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tabInit = .Range("A1:F" & fin).Value
    taille = (UBound(tabInit, 1) - 2) * UBound(tabInit, 2)
    ReDim tabFinal(1 To taille, 1 To 3)
    j = 1
    For i = 2 To UBound(tabInit, 1)
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2)
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
      
    Next i
End With

With Sheets("RES")
    .UsedRange.Offset(1, 0).Clear
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub
Cliquez pour agrandir...


Rebonjour Vgendron , j'exploite ton code et j'aimerais ajouter une condition pour l'export des résultats qui serait sous la forme suivante :
si A1= "Taux de prise" alors export vers onglet qui s'appelle "Taux de prise"
sinon si A1="Volume appels entrants" alors export vers onglet qui s'appelle "Volume appels entrants"
sinon si A1 = "appels Offerts CC" alors export vers onglet qui s'appelle "appels Offerts CC"


Tu saurais coder pour l'obtenir ou cela semble compliqué d'après toi? :)

Bichette
 
Vote positif 0 Vote négatif
B

Bichette001

XLDnaute Junior
Bichette001 à dit:
Rebonjour Vgendron , j'exploite ton code et j'aimerais ajouter une condition pour l'export des résultats qui serait sous la forme suivante :
si A1= "Taux de prise" alors export vers onglet qui s'appelle "Taux de prise"
sinon si A1="Volume appels entrants" alors export vers onglet qui s'appelle "Volume appels entrants"
sinon si A1 = "appels Offerts CC" alors export vers onglet qui s'appelle "appels Offerts CC"


Tu saurais coder pour l'obtenir ou cela semble compliqué d'après toi? :)

Bichette
Cliquez pour agrandir...
en fait que le nom de l'onglet soit associé à A1 et que cela écrase l'onglet concerné ..?
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Hello

VB: 
Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row 'nb de lignes du tableau initial
    NbCol = .Range("A1").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A1").Resize(NbLignes, NbCol).Value
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 1) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 3)
    j = 1
    For i = 2 To UBound(tabInit, 1)
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2)
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
       
    Next i
End With

With Sheets(tabInit(1, 1)) 'dans la feuille dont le nom est en cellule A1 (première cellule du tabInit)
    .UsedRange.Offset(1, 0).Clear
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

correction pour le bug: il devait y avoir un pb dans le calcul de la taille
pour le nom de la feuille. il faut qu'il soit mis en A1 à la place de date
si tu veux déplacer le tableau. il va falloir adapter le code pour calculer le nombre de lignes et de colonnes
 
Vote positif 0 Vote négatif
B

Bichette001

XLDnaute Junior
vgendron à dit:
Hello

VB: 
Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row 'nb de lignes du tableau initial
    NbCol = .Range("A1").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A1").Resize(NbLignes, NbCol).Value
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 1) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 3)
    j = 1
    For i = 2 To UBound(tabInit, 1)
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2)
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
      
    Next i
End With

With Sheets(tabInit(1, 1)) 'dans la feuille dont le nom est en cellule A1 (première cellule du tabInit)
    .UsedRange.Offset(1, 0).Clear
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

correction pour le bug: il devait y avoir un pb dans le calcul de la taille
pour le nom de la feuille. il faut qu'il soit mis en A1 à la place de date
si tu veux déplacer le tableau. il va falloir adapter le code pour calculer le nombre de lignes et de colonnes
Cliquez pour agrandir...

Merci Vgendron !! et sinon pour l'export conditionné par le nom en A1 ?...tu aurais une idée ça m'a l'air compliqué à faire ..
j'ai 3 elements en A1 feuille"indicateurs" (menu déroulant) et je souhaiterai que lorsque A1 = X alors export vers feuille X sinon si A1=Y alors export vers feuille Y sinon si A1 =W alors export vers feuille W
ce que j'appelle export c'est effacer les 4° colonnes de la feuille X par ex et copier coller les données de l'onglet "indicateurs"qui évoluent chaque jour...... tu vois ?
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
c'est déjà dans ma réponse
ici:
VB: 
With Sheets(tabInit(1, 1)) 'dans la feuille dont le nom est en cellule A1 (première cellule du tabInit)
    .UsedRange.Offset(1, 0).Clear
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With

Mais je suis quasi sur que tu as ou vas changer quelque chose dans ton fichier..
peux tu stp reposter ton fichier avec 2 ou 3 feuilles (X Y..) et la feuille de data avec le tableau et le nom en A1..
 
Vote positif 0 Vote négatif
B

Bichette001

XLDnaute Junior
Bonjour
voici en pj le fichier avec les onglets que j'aimerais effacer et remplir chaque fois que je fais la macro "transposer"
Je précise que je souhaite mettre un TCD ds chacun des 3 onglets de destination et que si cela est possible j'aimerais que le TCD et graph croisé dynamique ne s'efface pas lorsqu'on efface avec la macro avant de recopier-coller les données. Pt-être faudrait-il effacer les colonnes ABC par ex ?

est-il possible de m'expliquer à quoi sert Ubound et lbound .. pour que je progresse

Merci pour toute votre aide précieuse
Bichette
 

Pièces jointes

  • Test Bichette.xlsx
    12.1 KB · Affichages: 9
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Voila.. c'est bien ce que je pensais..
ton tableau de data n'est plus à la meme place. il commence en ligne 2
et en A1, tu as mis le nom de la feuille de destination..

voir code adapté
VB: 
Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    FeuilleDest = .Range("A1") ' la feuille de destination est indiquée dans la cellule A1
    'on détecte les données du tableau à exporter
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row - 1 'nb de lignes du tableau initial
    NbCol = .Range("A2").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A2").Resize(NbLignes, NbCol).Value
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 1) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 3) 'on définit les dimensions du tableau final
    j = 1
    For i = 2 To UBound(tabInit, 1) 'on commence à la ligne 2 du tableau pour ignorer la ligne d'entete
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2) 'pour chaque colonne du tableau
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
       
    Next i
End With

With Sheets(FeuilleDest) 'dans la feuille de destination (première cellule du tabInit)
    .UsedRange.Offset(1, 0).ClearContents 'on efface juste le contenu des cellules
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

pour les TCD..
1) je n'y connais rien
2) il faudrait au moins que tu postes ton fichier AVEC lesdits TCD
 
Vote positif 0 Vote négatif
B

Bichette001

XLDnaute Junior
vgendron à dit:
Voila.. c'est bien ce que je pensais..
ton tableau de data n'est plus à la meme place. il commence en ligne 2
et en A1, tu as mis le nom de la feuille de destination..

voir code adapté
VB: 
Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    FeuilleDest = .Range("A1") ' la feuille de destination est indiquée dans la cellule A1
    'on détecte les données du tableau à exporter
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row - 1 'nb de lignes du tableau initial
    NbCol = .Range("A2").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A2").Resize(NbLignes, NbCol).Value
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 1) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 3) 'on définit les dimensions du tableau final
    j = 1
    For i = 2 To UBound(tabInit, 1) 'on commence à la ligne 2 du tableau pour ignorer la ligne d'entete
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2) 'pour chaque colonne du tableau
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
     
    Next i
End With

With Sheets(FeuilleDest) 'dans la feuille de destination (première cellule du tabInit)
    .UsedRange.Offset(1, 0).ClearContents 'on efface juste le contenu des cellules
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

pour les TCD..
1) je n'y connais rien
2) il faudrait au moins que tu postes ton fichier AVEC lesdits TCD
Cliquez pour agrandir...



C'est top Vgendron !! je vais l'appliquer à mon tableau dès demain
Merci !!!!!!!!!!!!!!!!!!

sinon ubound et lbound sert à quoi stp?
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2021 suite de nombre avec changement tous les 5
Réponses
9
Affichages
443
mapomme
mapomme
O
  • Résolu(e)
XL 2013 Formule ou Codage VBA qui met à jour un tableau en fonction de quantité
Réponses
5
Affichages
225
onyirimba
O
C
  • Question
XL 2019 Distribuer des équipes en poules selon force et établissement
Réponses
2
Affichages
241
carlos
C
T
  • Résolu(e)
XL 2019 Mini championnat de pétanque
Réponses
8
Affichages
417
Gégé-45550
Gégé-45550
estebat
  • Question
XL pour MAC Création tableau Olympiades
Réponses
3
Affichages
822
estebat
estebat
D
  • Question
Microsoft 365 transformer une équation mathématique en formule excel
Réponses
4
Affichages
587
Daniel200666
D
M
  • Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
733
Mody200
M
L
  • Résolu(e)
Microsoft 365 Liste déroulante + SI
Réponses
8
Affichages
859
Lhoreley
L
T
  • Question
XL pour MAC Calcul de notes.
Réponses
5
Affichages
614
Katido
K
R
  • Résolu(e)
XL 2021 Transformer des données
Réponses
4
Affichages
436
Richard30
R

Membres actuellement en ligne

3 membres et 36 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 097
Messages
2 116 187
Membres
112 679
dernier inscrit
Yupanki