XL 2016 [RESOLU] Macro suppression doublon sauf si ...

[aragdur]

Bonjour,

J'ai fait une macro à la wannegain appelée "Doublons" qui fait actuellement le travail, c'est à dire
- copier une liste "tableau de saisie B:C" vers "tableau de données AJ:AK"
- virer les doublons
- trier par ordre alphabétique
- virer les cellules vides.

Ces données me servent ensuite pour faire une liste déroulante dans "catalogue B4" qui donnera automatiquement une date correspondante en B6.

Sauf que, cette date unique actuellement ne le restera pas.

En effet, pour un show à Paris, je pourrai avoir le 27/01 ou le 28/01

Donc, je cherche l'amélioration de ma macro actuelle (Doublons) pour pouvoir créer ma liste multichoix.

En résumé, une fois la macro doublons faites, je choisirai mon lieu (sans doublons) puis j'aurai le choix entre plusieurs date dans une liste de données (avec fonction recherchev par exemple)

merci pour le coup de direction à suivre.

 

[Bebere]

bonjour
aragdur l'userform est complété pour lieu et date
userform outil idéal pour compléter une base de données

 

[aragdur]

bonjour
aragdur l'userform est complété pour lieu et date
userform outil idéal pour compléter une base de données

Salut,
merci pour ton approche.

Par contre, j'ai toutes les dates qui s'affichent et non celles possibles.

Par exemple, si je choisi Paris, je veux les dates de Paris pas plus

Faut-il que je rajoute un code liste déroulante incrémenté stp ?

et un bouton ok ou valider ?

cdlt

 

[Bebere]

bonjour
aragdur le code changé pour ce que tu veux

Dim ws As Worksheet
Dim d As Dictionary, a, i As Long

Private Sub ComboBox1_Click()

Set d = New Dictionary
For i = 1 To UBound(a)
If a(i, 1) = Me.ComboBox1 Then d(a(i, 2)) = a(i, 2)
Next
Me.ComboBox2.List = d.Items

End Sub

Private Sub UserForm_Initialize() 'outils,références,choisir dans la liste microsoft scripting runtime et cocher

Set ws = Worksheets("Tableau de saisie")
Set d = New Dictionary
a = ws.Range("B2:C" & ws.Range("B65000").End(xlUp).Row).Value
For i = 1 To UBound(a)
d(a(i, 1)) = a(i, 1)
Next

Me.ComboBox1.List = d.Items

End Sub

 

[aragdur]

bonjour
aragdur le code changé pour ce que tu veux

Dim ws As Worksheet
Dim d As Dictionary, a, i As Long

Private Sub ComboBox1_Click()

Set d = New Dictionary
For i = 1 To UBound(a)
If a(i, 1) = Me.ComboBox1 Then d(a(i, 2)) = a(i, 2)
Next
Me.ComboBox2.List = d.Items

End Sub

Private Sub UserForm_Initialize() 'outils,références,choisir dans la liste microsoft scripting runtime et cocher

Set ws = Worksheets("Tableau de saisie")
Set d = New Dictionary
a = ws.Range("B2:C" & ws.Range("B65000").End(xlUp).Row).Value
For i = 1 To UBound(a)
d(a(i, 1)) = a(i, 1)
Next

Me.ComboBox1.List = d.Items

End Sub

re

merci
j'ai ensuite créé le bouton ok, c'est tout ce qui m'intéresse via :

Private Sub CommandButton1_Click()

validFerm = False
Unload Me

End Sub

je m'attendais à une recopie pure et simple des infos sur ma feuille et là ...
Loose
rien ne se passe ^^'

Juste pour savoir pour m'éviter de faire le taf en double, t'as pas insérer le code pour afficher le userform ?
(ça je sais faire ... youpi)

cdlt

 

[Bebere]

je vais ajouter un bouton valider
edit:ajout fichier

 

[aragdur]

Salut,

tout d'abord désolé de ne pas avoir répondu plus tôt.
Les déplacements, ça use.

Je me rends compte que je me suis mal exprimé dans mon premier post et donc je t'ai envoyé sur une fausse piste.

donc, je recommence :

je suis en train de créer un catalogue pour des show animalier. (cf. PJ)
J'ai un tableau principal de saisie, un tableau de données (c'est mon fourre tout) et le fameux catalogue (en cours de création ...).
Les autres onglets me permettent de faire des tris personnalisés et me seront peut être très utile dans ma création.

Actuellement, je bloque sur le début de mon catalogue.
Je souhaite pouvoir mettre sous format de liste déroulante le lieu et la date du show.
La liste déroulante de la date dépendra du lieu. je peux avoir plusieurs dates pour un lieu (par ex : Paris : soit le 01/01 soit 01/02)
Concernant les lieux, j'en aurai également plusieurs.

Globalement, j'arrive à extraire le lieu en dégageant les doublons.
Mais je n'arrive pas à faire la deuxième liste déroulante en ayant toutes les dates par lieu.

Auriez-vous une idée s'il vous plaît ?

https://www.cjoint.com/c/HAElFQg5Eqf

 

[Bebere]

bonjour
Aragdur je pense que c'est comme cela que tu obtiendras ce qu'il te faut
as-tu vu la réponse du post #6

Sub LieuDate()
    Dim a(), b(), d As Dictionary, i As Long, j As Long, L As Long, c As Long, ws As Worksheet
    Dim item As Variant, MaDate As Date
    Feuil27.Range("AK1:AN1000").ClearContents
    Set ws = Worksheets("Tableau de saisie")
    Set d = New Dictionary
    L = ws.Range("B65000").End(xlUp).Row
    a = ws.Range("B2:C" & L).Value
    c = Feuil27.Range("AL2").Column
    For i = 1 To UBound(a)
        MaDate = a(i, 2)
        a(i, 2) = CDbl(MaDate)
        d(a(i, 1)) = a(i, 1)
    Next
    Feuil27.Range("AL1").Resize(, d.Count) = d.Items
    Feuil27.Range("AK2").Resize(d.Count) = Application.Transpose(d.Items)

    b = d.Items
    For i = LBound(b) To UBound(b)
        Set d = New Dictionary
        For j = 1 To UBound(a)
            If a(j, 1) = b(i) Then d(a(j, 2)) = a(j, 2)
        Next
        Feuil27.Cells(2, c).Resize(d.Count) = Application.Transpose(d.Items): c = c + 1
    Next
   
End Sub

 

[aragdur]

salut,

merci beaucoup pour ce travail

bonne soirée