Recherche multicritère VBA

[nextrevolution]

JP 14 m'a donné un fichier de recherche multicritères mais lors de quelques modifications ca bogue, j'ai passé 4 heures dessus et comme je suis pas très fort en VBA je m'en remet à vous pour m'aider.

CI joint mon ficher avec mes problèmes qui sont énoncés dedans

 

[jp14]

Re : Recherche multicritère VBA

Bonjour

Ci dessous le fichier excel avec les fonctions demandées.

A tester

JP

 

[nextrevolution]

Re : Recherche multicritère VBA

Parfait, ca fonctionne niquel.

Je vais essayer de regarder les changements pour voir mes erreurs et essayer par la suite d'y arriver moi même

 

[nextrevolution]

Re : Recherche multicritère VBA

J'ai réussi à tout mettre en forme en suivant t'es conseil mais j'ai denouveau ce problème avec le mot lumière. A la base j'ai rien.
Il viens dés que je modifie l'ordre de mes colonnes, même si je fais retour et mais colonne sans dans l'ordre initial le problème est toujours là.

 

[jp14]

Re : Recherche multicritère VBA

Bonjour

Les procédures n'aiment pas les lignes vides : lumières


A modifier
Private Sub remplircombobox(£pseleccombo As Variant)

.....................................................
    ' on transfère la collection dans un tableau
    If £coll.Count > 1 Then
        ReDim £laliste(£coll.Count - 1)
        For £n = 1 To £coll.Count
            £laliste(£n - 1) = £coll(£n)
        Next £n
        If UBound(£laliste) > LBound(£laliste) Then Call tri(£laliste(), 1, UBound(£laliste, 1))
    ' on affecte le tableau au combobox
    
        Me.Controls("ComboBox" & £nucombo).List = £laliste
    Else
        If £coll.Count > 0 Then Me.Controls("ComboBox" & £nucombo).AddItem £coll(£coll.Count)
    End If

S'il n'y a qu'une donnée ce n'est pas la peine de trier.
JP

 

[jp14]

Re : Recherche multicritère VBA

Bonjour

J'ai trouvé le problème,( j'en perdait mon latin) la fonction "sorted" qui est cochée dans les paramètres pose parfois des problèmes, des lignes ne sont pas affichées correctement.

J'ai rajouté l'option de tri, un double click sur la colonne permet de trier les données.


JP

 

[nextrevolution]

Re : Recherche multicritère VBA

Merci,

Il y a encore juste un petit problème sur ce que tu as rajouté pour le tri. Lorsque tu cliques pour trier par marque ou modéle le nom des photos s'enléve.
Mais bon pour le moment c'est pas important car je sais pas encore si on va utiliser les photos (c'est pas la priorité)

Je sais pas comment tu as réussi mais ca fonctionne lol. En tout cas merci, je vais essayer de trouver des fichiers déja réalisé pour poursuivre mon code pour la suite de la réservation. Si tu as denouveau des pistes.

Il faut maintenant qu'une fois l'objet trouvé je clique dessus pour qu'il se mette dans ListView2, ainsi de suite pour chaque objet pour qu'il compléte la liste. Puis une fois la liste compléte, on valide la réception puis ca envoie tout ces valeurs dans ...
(je sais pas qu'elle solution adopter car il faut que c'est objet par la suite ne soit plus sélectionnable, je vais m'inspirer du premier fichier que tu m'as donné avec le calendrier)

 

[jp14]

Re : Recherche multicritère VBA

Bonsoir

Il faut modifier cette procédure

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim date1 As Date
Dim i As Integer
        Call tierliste(1, ColumnHeader.Index - 1)

End Sub

JP

 

[jp14]

Re : Recherche multicritère VBA

Bonsoir

Il faut modifier cette procédure

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim date1 As Date
Dim i As Integer
        Call tierliste(1, ColumnHeader.Index - 1)

End Sub

JP

 

[nextrevolution]

Re : Recherche multicritère VBA

Ca fonctionne pas.
Je te joins le fichier si tu veux jeter un coup d'oeil mais bon c'est pas grave sinon.

Merci pour ton aide

 

[jp14]

Re : Recherche multicritère VBA

Bonjour

Ci joint le fichier avec une modifications des procédures au niveau du tri des colonnes.
On constate au niveau de la listview des lignes incomplètes, les données dans les colonnes ne sont pas enregistrées ce qui entraine une erreur lors de leur lecture. La disparition des données dans ces lignes provient du tri.
Pour éviter ce problème il faut mettre la propriété "sorted" à false après un tri.

Un double click sur une ligne permet de remplir la deuxième listview

JP

 

[nextrevolution]

Re : Recherche multicritère VBA

J'ai continué mon fichier réservation, mais j'ai une erreur de compilation et j'arrive pas à trouver d'où ca vient.

Au niveau de mon UserForm1, quand je valide ma réservation j'aimerais que toutes les références de ma listbox2 se mettent dans un tableau selon la date un peu sur le principe du fichier gestionlocation que tu m'avais donné.

Mon fichier, même zipé est trop grand pour le mettre sur le forum je peux faire comment? Parce que si j'efface une aprtie de mon code on vois plus l'erreur

 

[jp14]

Re : Recherche multicritère VBA

Bonjour


En utilisant le site Accueil de Cjoint.com
ou en passant par
Lien supprimé

JP

 

[nextrevolution]

Re : Recherche multicritère VBA

Voila,

http://cjoint.com/?echEdD4VuJ

 

[jp14]

Re : Recherche multicritère VBA

Bonjour

Ci dessous les codes à modifier ou à ajouter
Pour supprimer une ligne dans la listview2

Private Sub ListView2_DblClick()
ListView2.ListItems.Remove ListView2.SelectedItem.Index
End Sub

Pour enregistrer les données dans une feuille.
A modifier éventuellement.

' Bouton          :valider resa
'--------------------------------------------------
Private Sub CommandButton105_Click()
nomfeuille1 = "feuil1"
DerLi = Sheets(nomfeuille1).Range("a65536").End(xlUp).Row + 1
With ListView2
    For k = 1 To .ListItems.Count
        DerLi = Sheets(nomfeuille1).Range("a65536").End(xlUp).Row + 1
        Sheets(nomfeuille1).Range("a" & DerLi).Value = .ListItems(k).Text
        For i = 1 To .ColumnHeaders.Count - 1
             Sheets(nomfeuille1).Cells(DerLi, i + 1).Value = .ListItems(k).ListSubItems(i).Text
        Next i
    Next k
End With
End Sub

Code pour l'userform2

Private Sub UserForm_Initialize()
With TextBoxResa
If Sheets("Référence Réservation").Range("a65000").End(xlUp).[COLOR="Red"]Row[/COLOR] = 1 Then
    .Value = 1
Else
    .Value = Sheets("Référence Réservation").Range("a65000").End(xlUp).[COLOR="Red"]Row[/COLOR] + 1
End If
    .Enabled = False
End With
End Sub

A tester

JP