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
 

Pièces jointes

  • FEEL_VBA.xlsm
    47.9 KB · Affichages: 8

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)


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
 

Pièces jointes

  • FEEL_VBA2.xlsm
    47.1 KB · Affichages: 6

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
 

Discussions similaires

Réponses
2
Affichages
108
Réponses
12
Affichages
225

Statistiques des forums

Discussions
311 711
Messages
2 081 794
Membres
101 817
dernier inscrit
carvajal