XL 2013 Mettre en forme des élements d une base de données

[LORDDD]

Bonjour et bonne année 2017 à vous tous.
Je tente de mettre en forme une base de données brutes en tableau facilement lisible

Onglet base vous avez les données brutes a savoir 5 hôtels sur différentes dates avec 2 tarifs
Onglet Récap, je souhaite ranger par hôtel par date un seul type de prix, et ajouter l'info code prix et saison.

Vous trouverez un bout de code VBA dans le projet mais tourne en rond.

Merci de votre aide
Cordialement

 

[Dranreb]

Boujour.
Peut être aurez vous plus de facilité à explorer une collection élaborée par ma fonction Gigogne que vous trouverez dans ce classeur

 

[LORDDD]

Merci beaucoup pour ce travail.
La macro me semble fort compliqué a décortiquer, et je suis loin d'être un expert, je vais l'éditer et tenter de comprendre.

 

[Paf]

Bonjour LORDDD,

un essai:

Sub Transfert()
Dim T, dico, i As Long, Lig As Long, Col As Integer, T1, T2
Set dico = CreateObject("Scripting.Dictionary")
With Worksheets("Base")
T = .Range("A4:J" & .Range("A" & Rows.Count).End(xlUp).Row)
Dini = CDbl(.Range("A4"))
End With
For i = LBound(T, 1) To UBound(T, 1)
    If T(i, 8) = "Previous" Then
        clé = T(i, 3) & "|" & CDbl(T(i, 1))
        dico(clé) = T(i, 5) & "|" & T(i, 10) & "|" & T(i, 9)
    End If
Next

With Worksheets("Recap")
For Each clé In dico.keys
    T1 = Split(clé, "|")
    T2 = Split(dico(clé), "|")
    Lig = CLng(Right(T1(0), 1)) * 3
    Col = T1(1) - Dini + 3
    Cells(Lig, 1) = T1(0)
    Cells(2, Col) = T1(1)
    Cells(Lig, Col).Resize(UBound(T2, 1) + 1, 1) = Application.Transpose(T2)
Next
End With
End Sub

A+

 

[gosselien]

Bonjour,

peut être avec TCD et segment ?

P.

 

[LORDDD]

Merci Gosselien pour ton aide mais le TCD ne me convient pas, j'y avais pensé.

Paf je teste ta solution mais petit bug au niveau
Lig = CLng(Right(T1(0), 1)) * 3

Je pense que ton idée est la bonne pour ma problematique

 

[Paf]

re et bonjour gosselien,

Je viens de me souvenir que dans la feuille Base, colonne C, pour l'Hotel 1, il y a un espace après le 1 ( cet espace n'existe pas pour les autres )

Espace à supprimer par rechercher "1 " et remplacer par "1" sur toute la colonne C.

A+

 

[LORDDD]

Ok Paf, je viens de faire la modif.
Pour l'exemple j'avais simplifier les noms d 'hotels mais en reel les nom sont du style :
Hôtel de la place d'air, légèrement plus compliqué, est ce que cela marche aussi.

En tout cas tu viens de me sauver...!
Merci de ton aide précieuse, et de la participation de Gosselien et Dranreb

 

[Dranreb]

La macro me semble fort compliqué a décortiquer

Ne cherchez pas, bien sûr à décortiquer la programmation de service, ça ne sert à rien. Lisez juste les commentaires guide d'utilisation pour avoir une idée claire de ce que renvoie toujours la fonction Gigogne selon les paramètres qu'on lui spécifie, comme dans la Sub Worksheet_Activate() utilisatrice. Une fois cela compris par cœur vous pourrez écrire des procédures faciles et courtes. Mais comment ça marche, ça ne sert à rien d'essayer de le comprendre.

 

[Paf]

Re,

Pour l'exemple j'avais simplifier les noms d 'hotels mais en reel les nom sont du style :
Hôtel de la place d'air, légèrement plus compliqué, est ce que cela marche aussi.

dans ces conditions ça marchera moins bien, puisque je m'appuyais sur ce N° pour déterminer le N° de ligne où écrire les résultats.

Je regarde pour modif.

A+

 

[Paf]

Re,

nouvelle version qui accepte n'importe quel nom d'hotel.

Transfert_V2()
Dim T, dico, dico2, i As Long, Lig As Long, Col As Integer, T1, T2, x As Integer
Set dico = CreateObject("Scripting.Dictionary")
Set dico2 = CreateObject("Scripting.Dictionary")
With Worksheets("Base")
T = .Range("A4:J" & .Range("A" & Rows.Count).End(xlUp).Row)
Dini = CDbl(.Range("A4"))
End With
For i = LBound(T, 1) To UBound(T, 1)
    If Not dico2.exists(T(i, 3)) Then
        x = x + 1
        dico2(T(i, 3)) = x
    End If
Next

For i = LBound(T, 1) To UBound(T, 1)
    If T(i, 8) = "Previous" Then
        clé = T(i, 3) & "|" & CDbl(T(i, 1))
        dico(clé) = T(i, 5) & "|" & T(i, 10) & "|" & T(i, 9)
    End If
Next

With Worksheets("Recap")
For Each clé In dico.keys
    T1 = Split(clé, "|")
    T2 = Split(dico(clé), "|")
    'Lig = CLng(Right(T1(0), 1)) * 3
    Lig = dico2(T1(0)) * 3
    Col = T1(1) - Dini + 3
    Cells(Lig, 1) = T1(0)
    Cells(2, Col) = T1(1)
    Cells(Lig, Col).Resize(UBound(T2, 1) + 1, 1) = Application.Transpose(T2)
Next
End With
End Sub

A+

 

[LORDDD]

Paf,
Bonjour a toi.
Merci beaucoup pour l'écritures de ce script.
Je regarde ça de suite sur mon dossier.

Et je te dis

 

[LORDDD]

Ok cela fonctionne super bien , j'ai juste ajouter une petite ligne de plus, car je lance le programme de la page Para en moyenne.

Sheets ("Recap"). Select
With Worksheets("Recap")
For Each clé In dico.keys
   ........

 

[Paf]

Re,

Ok cela fonctionne super bien , j'ai juste ajouter une petite ligne de plus, car je lance le programme de la page Para en moyenne.

à moins qu'on veuille afficher la feuille Para, Sheets ("Recap"). Select ne sert à rien puisque toutes les lectures écritures sont référencées à une feuille. On reste donc sur la feuille active au moment du lancement, et si au moment du lancement on est sur la feuille Para ..... on y reste ....

Par ailleurs, pas compris "car je lance le programme de la page Para en moyenne"

A+

 

[LORDDD]

Oui je lance ma macro en étant sur la feuille Para, et sans l ajout de ma petite ligne il me colle les recherche sur la feuille ou je me trouve

Voila pourquoi j ai ajoutez cette ligne.