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

LORDDD · 4 Janvier 2017

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 · 4 Janvier 2017

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

LORDDD · 4 Janvier 2017

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 · 4 Janvier 2017

Bonjour LORDDD,

un essai:

VB:

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 · 4 Janvier 2017

Bonjour,

peut être avec TCD et segment ?

P.

LORDDD · 4 Janvier 2017

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 · 4 Janvier 2017

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 · 4 Janvier 2017

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 · 4 Janvier 2017

LORDDD à dit:
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 · 4 Janvier 2017

Re,

LORDDD à dit:
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 · 4 Janvier 2017

Re,

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

VB:

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 · 5 Janvier 2017

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 · 5 Janvier 2017

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.

Code:

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

Paf · 5 Janvier 2017

Re,

LORDDD à dit:
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 · 5 Janvier 2017

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.

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

LORDDD

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

LORDDD

XLDnaute Occasionnel

Paf

XLDnaute Barbatruc

gosselien

XLDnaute Barbatruc

Pièces jointes

LORDDD

XLDnaute Occasionnel

Paf

XLDnaute Barbatruc

LORDDD

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

LORDDD

XLDnaute Occasionnel

LORDDD

XLDnaute Occasionnel

Paf

XLDnaute Barbatruc

LORDDD

XLDnaute Occasionnel

Discussions similaires