Colonne paramétrée suivant Listbox

Version imprimable

Bonjour à tous,

Je souhaite, en fonction du choix fait dans une Listbox, faire une recherche dans la colonne correspondante.
Ma Listbox correspond aux titres des colonnes. Je retrouve donc le bon numéro de colonne ainsi :
Code:

1 2 3 4 5 6 7 'Recherche du numéro de colonne pour output Set celluletrouvee2 = Range("A1:HE1").Find(ListBox1.Value, LookAt:=xlWhole) If Range("A1:HE1").Find(ListBox1.Value, LookAt:=xlWhole) Is Nothing Then TextBox2.Value = "" TextBox3.Value = "" Else f = celluletrouvee2.Column
Je sais le transformer en Lettre :

Code:

g = Chr(64 + f)

Mais maintenant je voudrais que le Range(« A :A ») actuellement en dur soit variable en fonction du résultat de la ListBox.
Code:

1 2 3 4 5 'recherche du code et libellé output Set c = Sheets(1).Range(« A :A »).Find(TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) If Not c Is Nothing Then TextBox2.Value = c.Offset(, e - 1).Value TextBox3.Value = c.Offset(, e).Value
Merci d'avance pour votre aide que j'imagine deja préciseuse !
8-)

balises code

Bonjour

Une autre variante, créer un fonction personnalisée retrouvant la bonne colonne. et l'utiliser après
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 Private Function MaColonne() As Integer Dim v As Range Set v = Worksheets(1).Rows(1).Find(ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole) If v Is Nothing Then TextBox2.Value = "" TextBox3.Value = "" Else MaColonne = v.Column Set v = Nothing End If End Function 'recherche du code et libellé output Sub Trouve() Dim F As Integer Dim c As Range F = MaColonne() If F > 0 Then Set c = Worksheets(1).Columns(F).Cells.Find(TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) If Not c Is Nothing Then TextBox2.Value = c.Offset(, e - 1).Value TextBox3.Value = c.Offset(, e).Value Set c = Nothing End If End If End Sub
Sinon, si les titres sont ordonnés de la même manière que les items de ta listbox, il suffit d'utiliser la propriété ListIndex de ta Listbox (avec un décalage adéquat. car le premier item choisi a un listindex de 0) pour tomber pile poil sur la colonne en question.

18/06/2013, 11h38
jipeh

Merci pour cette réponse super rapide !

Une petite précision, pour créer la fonction personnalisée, je vais créer un module. Je met tout ton code dedans ?

A la base mon code est dans un formulaire : Private Sub CommandButton1_Click()
18/06/2013, 11h49
mercatog

Pas besoin de la créer dans un module standard. D'ailleurs c'est une fonction privée.

La fonction est à écrire dans le module de ton userform (avant le début ou après la fin ta Private Sub CommandButton1_Click() )
18/06/2013, 12h07
jipeh
Impec pour la fonction privée. Merci !!

Par contre quand je lance mon code, je n'ai pas de retour dans les TextBox2 et TextBox3.

En effet, des stops, je me suis rendu compte que les deux
Code:

1 2 TextBox2.Value = c.Offset(, e - 1).Value TextBox3.Value = c.Offset(, e).Value
me fournissent le résultats que si la valeur est sur la première colonne du tableau (anciennement A:A en dur) alors qu'il faudrait renvoyer le résultat de la colonne output.

Comme je ne connais pas trop le fonctionnement de ces fonction...
18/06/2013, 12h25
mercatog

Je ne t'avais pas proposé tout le code mais la démarche.

Qu'as tu comme valeur de la variable e?

Tu fais ta recherche sur la première feuille?

Sans fichier, il sera difficile de te guider alors que tu peux faire le débogage pas à pas avec un point d'arrêt et vérifier l'état de tes variables par rapport à tes données.
18/06/2013, 15h33
jipeh

1 pièce(s) jointe(s)

Voici une partie du fichier.

Je souhaite donc mettre le type de code en entrée, le code recherché dans la box suivante et le code retour voulu en box 3.

Suivant mon tableau, il est possible d'avoir plusieurs résultats. Toutefois je ne sais pas si il est possible d'afficher plus que le premier...

Encore tous mes remerciements.

Tu n'as pas compris le fonctionnement de la fonction MaColonne.

Par contre, la même chose est utilisée pour trouver e à partir de ListBox2, pourquoi ne pas utiliser la même fonction légèrement modifiée.

Ci-joint les 2 codes modifiés et testé sur ton fichier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Function MaColonne(ByVal Str As String) As Integer
Dim v As Range
 
If Str <> "" Then
    Set v = Worksheets(1).Rows(1).Find(Str, LookIn:=xlValues, LookAt:=xlWhole)
    If v Is Nothing Then
        TextBox2.Value = ""
        TextBox3.Value = ""
    Else
        MaColonne = v.Column
        Set v = Nothing
    End If
End If
End Function
 
Private Sub CommandButton1_Click()
Dim E As Integer, F As Integer
Dim c As Range
 
E = MaColonne(ListBox2.Value)
F = MaColonne(ListBox1.Value)
If F * E > 0 Then
    Set c = Worksheets(1).Columns(F).Cells.Find(TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
    If Not c Is Nothing Then
        TextBox2.Value = c.Offset(, E - 1).Value
        TextBox3.Value = c.Offset(, E).Value
        Set c = Nothing
    End If
End If
End Sub

20/06/2013, 13h40
jipeh
Super travail !!

J'ai modifié ca :
Code:

1 2 3 4 If Not c Is Nothing Then TextBox2.Value = c.Offset(, E - 1).Value TextBox3.Value = c.Offset(, E).Value Set c = Nothing
en ca :
Code:

1 2 3 4 If Not c Is Nothing Then TextBox2.Value = c.Offset(, E - F).Value TextBox3.Value = c.Offset(, E - F + 1).Value Set c = Nothing
Comme ca je peux faire la recherche dans les deux sens.

Par contre; évidement mon (et pas que le mien d'ailleurs !) code renvoi la première valeur trouvée. Je cherche maintenant à avoir toutes les valeurs possibles.

Il faut que je fasse quelque chose du type :
Code:

1 2 For i = 1 To x i = i + 1
ou utiliser un index avec un saut de ligne entre chaque retour valide.

Encore merci

Les résultats séparés par une virgule

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub CommandButton1_Click()
Dim Prem As String, Str2 As String, Str3 As String
Dim E As Integer, F As Integer
Dim c As Range
 
E = MaColonne(ListBox2.Value)
F = MaColonne(ListBox1.Value)
If F * E > 0 Then
    With Worksheets(1).Columns(F).Cells
        Set c = .Find(TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        If Not c Is Nothing Then
            Prem = c.Address
            Do
                Str2 = Str2 & "," & c.Offset(, E - F).Value
                Str3 = Str3 & "," & c.Offset(, E - F + 1).Value
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Prem
            Str2 = Mid(Str2, 2)
            Str3 = Mid(Str3, 2)
        End If
    End With
End If
Me.TextBox2.Value = Str2
Me.TextBox3.Value = Str3
End Sub

20/06/2013, 17h11
jipeh

J'ai modifié ca pour mettre des saut de lignes entre les valeurs mais je me suis heurté un petit moment aux propriétés de ma Textbox...

En fait je crois que j'ai une idée à chaque fois mais la promis c'est la dernière :)
On peut éliminer les doublons dans le résultat ? Un doublon de se caractérise que par un meme résultat dans Textbox 2 ou str2 en fait.

A vérifier et à adapter. L'idée est là

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub CommandButton1_Click()
Dim Prem As String, Str2 As String, Str3 As String, Tmp As String
Dim E As Integer, F As Integer
Dim c As Range
 
E = MaColonne(ListBox2.Value)
F = MaColonne(ListBox1.Value)
If F * E > 0 Then
    With Worksheets(1).Columns(F).Cells
        Set c = .Find(TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        If Not c Is Nothing Then
            Prem = c.Address
            Do
                Tmp = c.Offset(, E - F).Value
                If InStr(Str2, Tmp) = 0 Then Str2 = Str2 & vbNewLine & Tmp
                Tmp = c.Offset(, E - F + 1).Value
                If InStr(Str3, Tmp) = 0 Then Str3 = Str3 & vbNewLine & Tmp
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Prem
            Str2 = Mid(Str2, 2)
            Str3 = Mid(Str3, 2)
        End If
    End With
End If
Me.TextBox2.Value = Str2
Me.TextBox3.Value = Str3
End Sub

NICKEL !

En plus de tout cela je me suis amusé à créer une MSGBOX personnalisé (avec de l'aide rassurez vous...). Voila la fonction de msgbox perso :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
'Création de la fonction msgbox personnalisé
Function mDFmsgBox(Titre$, Message$, Align As Byte, Police$, TailleCaract As Byte, ParamArray B()) As Byte
Dim USF As Object
Dim btnB As MSForms.CommandButton
Dim lblM As MSForms.Label
Dim LngMaxB As Integer, Marge As Integer, NbC As Integer
Dim i As Byte
       'Création du USF
      Set USF = ThisWorkbook.VBProject.VBComponents.Add(3)
       'Titre
      USF.Properties("Caption") = Titre
       'Zone de message
      Set lblM = USF.Designer.Controls.Add("Forms.Label.1")
      With lblM
            .Move 0, 15, 1000, 1000
            .WordWrap = False
            .Font.Size = TailleCaract
            .Font.Name = Police
            .Caption = Message
            .AutoSize = True
      End With
       'Boutons
      For i = 0 To UBound(B)
            Set btnB = USF.Designer.Controls.Add("Forms.CommandButton.1")
            With btnB
                  .AutoSize = True
                  .Caption = B(i)
                  LngMaxB = Application.Max(LngMaxB, .Width)
                  .AutoSize = False
            End With
      Next i
       'Mise en place des contrôles dans le USF
      With lblM
            USF.Properties("Width") = Application.Max((LngMaxB + 10) * (UBound(B) + 1) + 5, _
                        .Width + 20)
            USF.Properties("Height") = 85 + .Height
            .AutoSize = False
            .Move 10, 15, USF.Properties("Width") - 20, .Height
            .TextAlign = Align
      End With
      Marge = (USF.Properties("Width") - (LngMaxB + 5) * (UBound(B) + 1)) / 2
      For i = 0 To UBound(B)
            With USF
                  .Designer.Controls("CommandButton" & i + 1).Move Marge + (LngMaxB + 5) * i, _
                              lblM.Top + lblM.Height + 15, LngMaxB, 20
                   'Procédures évènementielles liées aux boutons
                  With .CodeModule
                        .InsertLines .CountOfLines + 1, "Sub CommandButton" & i + 1 & "_Click():VmsgBox =" _
                                    & i + 1 & " :Unload Me:End Sub"
                  End With
            End With
      Next i
       'Empêche fermeture par la croix
      With USF.CodeModule
            .InsertLines .CountOfLines + 1, "Private Sub UserForm_QueryClose(Cancel As Integer," _
                        & " CloseMode As Integer):Cancel = CloseMode = 0:End Sub"
      End With
       'Affiche, puis détruit le USF
      VBA.UserForms.Add(USF.Name).Show
      ThisWorkbook.VBProject.VBComponents.Remove USF
      mDFmsgBox = VmsgBox
End Function

et voila ma MSGBOX perso :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub Workbook_Open()
Dim Titre As String, Message As String, Police As String
Dim Alignement As Byte, Taille As Byte
Dim Choix As Byte
      Titre = "Mapping choice"
      Alignement = 2         '1=Droite / 2=Centre / 3=Gauche
      Police = "Arial"
      Message = "Which kind of map do you want to use ?"
      Choix = mDFmsgBox(Titre, Message, Alignement, Police, 10, "SIC", "ISIC", "JSIC", "NACE")
 
'      MsgBox "You choose : " & Choose(Choix, "SIC", "ISIC", "JSIC", "NACE"), vbOKOnly
            Select Case Choix
      Case 1
      Worksheets(1).Activate
      Case 2 = Worksheets(3).Select
      Case 3 = Worksheets(2).Activate
      Case 4 = Worksheets(4).Activate
      End Select
 
End Sub

Tout fonctionne bien sauf la sélection des onglets au final. Je n'arrive pas (ca se voit j'ai essayé plusieurs résultats...) à ouvrir les onglets correspondants au click sur le bouton...

24/06/2013, 17h00
jipeh

Après analyse il s'avère que mes boutons me renvoient tous la valeur 0...