XL 2019 VBA_Transformer tableau double entrée

Spinzi

XLDnaute Impliqué
Bonjour à toutes et à tous,

Je cherche à peaufiner le code VBA trouvé pour arriver à mon besoin.
Dans le fichier ci joint, je cherche à transformer le tableau à double entrée de l'onglet "FORMULAIRE" pour le coller au format "table" dans l'onglet "MEF".
Le bouton se trouve en ligne 30 (en dessous le tableau).

Le code trouvé fonctionne bien :
Code:
Sub FEEL_format()
Dim a, i As Long, j As Long, b(), n As Long
a = Sheets("FORMULAIRE").Range("a2").CurrentRegion.Value
ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 3)
For j = 2 To UBound(a, 2)
For i = 2 To UBound(a, 1)
If Not IsEmpty(a(i, j)) Then
n = n + 1
b(n, 1) = a(i, 1)
b(n, 2) = a(1, j)
b(n, 3) = a(i, j)
End If
Next
Next
'--- Restitution
With Sheets("MEF").Cells(2, 1).Resize(n, 3)
.CurrentRegion.Offset(1, 0).ClearContents
.Value = b
End With
With Sheets("MEF").Cells(2, 1).CurrentRegion
.Sort Key1:=Sheets("MEF").Range("A2"), Order1:=1 ', Header:=xlGuess
End With

End Sub
SAUF pour 1 petite chose : je ne souhaite pas ramener la colonne B de l'onglet "MEF". Pourriez-vous m'aider ?
La solution de suppression de colonne n'est pas applicable dans le format final => il faut également que je puisse garder en cellules A1 et B1 des titres prédéfinis (voir besoin onglet "MEF") sans que la macro ne les écrase (qu'elle commence ligne 2 au final).

Merci à vous,
Spinzi
 

Fichiers joints

laurent950

XLDnaute Accro
Bonjour,
Je dirais tous simplement et très vite en corrigant cette ligne
'b(n, 2) = a(1, j) comme 1 c'est la ligne des titres et J les colonnes de tous les titres.
b(n, 2) = a(i, j)
1580239431225.png
Cdt
Laurent
 

laurent950

XLDnaute Accro
Avec une variable tableau, ci cela répond à vos intérogations, suite à votre question "
VBA_Transformer tableau double entrée"
VB:
Sub test()
Dim tabase As Variant
    tabase = Sheets("FORMULAIRE").Range("a2").CurrentRegion.Value
Dim taRes As Variant
ReDim taRes(LBound(tabase, 1) To UBound(tabase, 1), 1 To 1)
Dim cpt As Double: cpt = 1
    For i = LBound(taRes, 1) To UBound(taRes, 1)
        taRes(i, 1) = Application.Index(tabase, i)
    Next i
' dans la feuille MEF
For i = LBound(taRes) + 1 To UBound(taRes)
    'Sheets("MEF").Cells(i + cpt, 1).Resize(UBound(taRes(i, 1), 1)) = Application.Transpose(taRes(i, 1))
    'cpt = cpt + UBound(taRes(1, 1))
    For j = LBound(taRes(i, 1), 1) + 1 To UBound(taRes(i, 1), 1)
        If taRes(i, 1)(j) <> Empty Then
            Cells(cpt, 1) = taRes(i, 1)(1)
            Cells(cpt, 2) = taRes(i, 1)(j)
            cpt = cpt + 1
        End If
    Next j
Next i
End Sub
cdt
Laurent
 

Spinzi

XLDnaute Impliqué
Bonjour Laurent,

merci pour vos retours !

'b(n, 2) = a(1, j) comme 1 c'est la ligne des titres et J les colonnes de tous les titres.
b(n, 2) = a(i, j)
1580239431225.png


Cdt
Laurent
cela fonctionne et ne m'affiche pas la colonne des titres.
Cependant, il colle parfois les données dans la feuille MEF en A1 et parfois en A2.
Aussi il m'écrase les titres qui pourraient être présents ...
Auriez vous une solution ?

Avec une variable tableau, ci cela répond à vos intérogations, suite à votre question "
VBA_Transformer tableau double entrée"
VB:
Copier dans le presse-papier
Sub test()
Dim tabase As Variant
tabase = Sheets("FORMULAIRE").Range("a2").CurrentRegion.Value
Dim taRes As Variant
ReDim
taRes(LBound(tabase, 1) To UBound(tabase, 1), 1 To 1)
Dim cpt As Double: cpt = 1
For i = LBound(taRes, 1) To UBound(taRes, 1)
taRes(i, 1) = Application.Index(tabase, i)
Next i
' dans la feuille MEF
For i = LBound(taRes) + 1 To UBound(taRes)
'Sheets("MEF").Cells(i + cpt, 1).Resize(UBound(taRes(i, 1), 1)) = Application.Transpose(taRes(i, 1))
'cpt = cpt + UBound(taRes(1, 1))
For j = LBound(taRes(i, 1), 1) + 1 To UBound(taRes(i, 1), 1)
If taRes(i, 1)(j) <> Empty Then
Cells(cpt, 1) = taRes(i, 1)(1)
Cells(cpt, 2) = taRes(i, 1)(j)
cpt = cpt + 1
End If
Next j
Next i
End Sub
cdt
Laurent

Ce code ci doit être un petit peu retravaillé car il copie les données sur l'onglet "FORMULAIRE" et non pas dans l'onglet "MEF" => il écrase la base de données.

Merci,
A vous relire,
Spinzi
 

Fichiers joints

laurent950

XLDnaute Accro
Bonsoir,
je vous propose de me faire un copier coller se que vous avez envie d'avoir en feuille MEF et je corrige le code c'est plus simple
 

chris

XLDnaute Barbatruc
Bonjour à tous

Si j'ai bien compris : avec PowerQuery (intégré à ta version Exel) en quelques clics
(je n'ai pas effacé ton VBA)
 

Fichiers joints

Spinzi

XLDnaute Impliqué
Bonjour Bonjour,

@laurent : actuellement, j'ai copié ce bout de code en essayant de l'adapter pour qu'il colle à mon besoin (je ne sais pas utiliser les tableaux et arrays en vba). De ce que j'ai compris, le programme remet les données au format tabulaire à partir de la cellule A2 de l'onglet "MEF".
Mais si je rempli les cellules A1 et B1, alors la table obtenu contient des erreurs.

@chris : merci pour ce genre de solutions ! Je n'y avais pas du tout pensé et n'avais jamais vu cette fonction "supprimer TCD".

Bien à vous,
Spinzi
 

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