Base de données evolutive

[Joblo22]

Voici la problématique,

J'ai une base de données avec comme champs # client, nom, pronom et niveau. Un client peut faire plusieurs niveau (de 1 a 4). Je me retrouve donc avec des doublons dans ma base de données.

Mon but est d'analyser l'évolution des clients selon les niveaux. Je veux donc placer ma base de données sur l'horizontal.

** J'avais pensé faire un tri et effectuer une macro pour replacer les niveaux selon l'horizontal, mais je ne suis pas capable de faire la macro pour le tri automatique.

Pourriez-vous m'aider?

Merci

 

[CISCO]

Re : Base de données evolutive

Bonsoir

Deux posssibilités en pièces jointes, par formules, dont une matricielle (à valider avec ctrl+maj+entrer). Si ton fichier est très long, une macro serait certainement mieux.

@ plus

 

[Grand Chaman Excel]

Re : Base de données evolutive

Bonjour Joblo, Bonsoir Cisco,

Je suis plus du genre macro que formules... Voici une proposition par macro qui peut sûrement être optimisée un peu plus mais qui fait le travail quand même.

A+

 

[Joblo22]

Re : Base de données evolutive

Excellent, je vais tester les 2 formules sur mon vrai fichier qui effectivement est une très grande base de données.

En ce qui concerne la macro, je ne suis vraiment pas un expert dans le langage VB et lorsque je j'essaie d'effectuer la macro j'ai une erreur sur

Set rg3

???

 

[flyonets44]

Re : Base de données evolutive

bonjour
j'ai légèrement corrigé le code et ça marche chez moi
Cordialement
flyonets

 

[david84]

Re : Base de données evolutive

Bonjour tout le monde,
à tester :

Sub Extraction_BD()
Dim Plage As Range, Mondico As Object, i&, j&, k&, Nb&, tabl2
Application.ScreenUpdating = False
Set Plage = Sheets("Feuil1").[A1].CurrentRegion
Set Mondico = CreateObject("scripting.dictionary")
j = 0
For i = 1 To Plage.Rows.Count
    Mondico(Plage(i, 1) & Plage(i, 2) & Plage(i, 3)) = Plage(i, 1) & Plage(i, 2) & Plage(i, 3)
    Dim tabl()
    ReDim Preserve tabl(Plage.Rows.Count, Plage.Columns.Count - 1)
    tabl(j, 0) = Plage(i, 1)
    tabl(j, 1) = Plage(i, 2)
    tabl(j, 2) = Plage(i, 3)
    j = j + 1
Next i
With Sheets("Feuil2")
    .Activate
    .[A1].CurrentRegion.Clear
    Nb = Application.WorksheetFunction.Max(Plage.Columns(4))
    .[A1].Resize(Mondico.Count, Plage.Columns.Count) = tabl
    
        For i = 1 To Mondico.Count
        k = 1
            For j = 1 To Plage.Rows.Count
                If Plage(j, 1) = tabl(i - 1, 0) And Plage(j, 2) _
                = tabl(i - 1, 1) And Plage(j, 3) = tabl(i - 1, 2) Then
                    .Cells(i, 3 + k) = Plage(j, 4): k = k + 1: If k > Nb Then Exit For
                End If
            Next j
        Next i
    .Range(.Cells(1, 4), .Cells(1, 4 + Nb - 1)).Merge
    .Range(.Cells(1, 4), .Cells(1, 4 + Nb - 1)).HorizontalAlignment = xlCenter
    .Cells(1, 4).Value = "Evolution"
    .Range(.Cells(2, 4), .Cells(Mondico.Count, 4 + Nb - 1)).Activate
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
    .[A1].Select
    End With
    Application.ScreenUpdating = True
End Sub

A+