XL 2019 VBA_Transformer tableau double entrée

Spinzi · 28 Janvier 2020

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

laurent950 · 28 Janvier 2020

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)

Cdt
Laurent

laurent950 · 28 Janvier 2020

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 · 29 Janvier 2020

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)

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

laurent950 · 29 Janvier 2020

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 · 29 Janvier 2020

Bonjour à tous

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

Spinzi · 30 Janvier 2020

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

XL 2019 VBA_Transformer tableau double entrée

Spinzi

XLDnaute Impliqué

Pièces jointes

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Spinzi

XLDnaute Impliqué

Pièces jointes

laurent950

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

Pièces jointes

Spinzi

XLDnaute Impliqué

Discussions similaires