Discussion :

[jipeh]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !

[mercatog]

Bonjour

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[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()

[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() )

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[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.

[jipeh]

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.

[mercatog]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[jipeh]

Super travail !!

J'ai modifié ca :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mercatog]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.

[mercatog]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[jipeh]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[jipeh]

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