Code VBA pour convertir un tableau Excel en base de données

Bonjour,

je tatonne toujours en VBA : je bute sur une problème auquel j'espère vous m'aiderez à trouver une solution.

LUNDI MARDI MERCR

NOM A 1 1 2

NOM B 5 2 3

NOM C 2 3 7

NOM A LUNDI 1

NOM A MARDI 1

NOM A MERCR 2

NOM B LUNDI 5

Je souhaiterais convertir un tableau excel en base de données via vb. J'ai trouvé des choses sur les forums avec des formules de type decaler ou autre, mais je suis pas satisfaite...

Je pense qu'en VBA ce serait plus rapide et plus fiable.... mais j'attends mes limites.

En pièce jointe un doc

Merci d'avance !!!

bonjour,

Hum... C'est pas très clair !

A priori un tableau Excel ne se converti pas en base de données.

On emploie parfois improprement ces mots (Base de données) mais ce n'est en fait rien de plus qu'un tableau Excel...

Après, il y a quelques impératifs généralement admis pour ces pseudos bases de données :

Pas d'autres données que le tableau lui-même (comme c'est le cas en particulier dans ton classeur en B28:D52

La première colonne du tabaleau (BD) est une colonne Index sans doublons.

La première ligne du tableau contient les en-têtes de colonnes : ils doivent être unique (il ne peut y avoir 2 colonnes Ville ou date ou Age... et en principe une BD ne comporte pas de champs (colonne) calculée.

Le tableau s'arrête à la première colonne vide.

Après c'est à toi de préciser un peu plus tes attentes...

A+

Bonjour,

Une proposition à étudier.

Cdlt.

Bonjour à tous,

ah ! ben j'suis en retard, désolé

On n'avait pas dit 20h pour l'apéro ?

Sub convertir()
    Dim datas, result()
    Dim lig As Long, lig2 As Long, col As Long
    datas = [A1].CurrentRegion.Value
    ReDim result(1 To (UBound(datas, 1) - 1) * (UBound(datas, 2) - 1), 1 To 3)
    For lig = 2 To UBound(datas, 1)
        For col = 2 To UBound(datas, 2)
            lig2 = lig2 + 1
            result(lig2, 1) = datas(lig, 1)
            result(lig2, 2) = datas(1, col)
            result(lig2, 3) = datas(lig, col)
        Next col
    Next lig
    With Sheets("Feuil2")
        .[A:C].EntireColumn.Delete
        .[A2].Resize((UBound(datas, 1) - 1) * (UBound(datas, 2) - 1), 3) = result
        .[A1:C1] = Array("nom", "code", "item")
        .[A:C].EntireColumn.AutoFit
        .Activate
    End With
End Sub

eric

Merci beaucoup Eriic et jean Eric pour vos propositions. Ca m'a l'air au top tout ça !!!!et super rapide !

Je vais décortiquer pour mieux comprendre mais ça m'a l'air de correspondre parfaitement à ce que je cherche.

Merci beaucoup !!! je trinque à la vôtre