Salut,
Suite à la demande de Petchy en BAL, il ne veut pas afficher que le code dans une combo mais aussi 2 autres valeurs issues de colonnes différentes: Articles et Délais. Une autre fonction Equiv qui récupére toutes els valeurs associées.
Voir fichier joint.
Si le fichier joint ne passe pas=> rajouter 2 labels nommés label3 et label4 sur l'userform de Petchy. et coller ceci dans le code de l'userform.
Dim PLage As Range
Private Sub ComboBox1_Change()
With ComboBox2
.Clear
On Error Resume Next
'Les codes étant en colonne 2, on met 2 colonnes à la combo en cachant la 1 ere
'Il serait en colonne 4 on mettrait "0;0;0;60"
.ColumnCount = 2
.ColumnWidths = "0;60"
.List = InverseTab(Equiv2(ComboBox1.Text, PLage.Value, 7))
End With
NettoieLabels
End Sub
Private Sub ComboBox2_Change()
On Error Resume Next
With ComboBox2
'Par rapport à un feuille de calcul il faut enlever 1 aux lignes et aux colonnes
Label3.Caption = .List(.ListIndex, 0) 'Articles
Label4.Caption = .List(.ListIndex, 5) 'Délais
'on aurait un autre label
'Label5.Caption =.List(.ListIndex, 2) Q.gel coat
End With
End Sub
Private Sub UserForm_Initialize()
Set PLage = Range([A2], [G65536].End(xlUp))
'Suppression des doublons par tableau sur la colonne 7<=>clients
ComboBox1.List = RecupDoublons(PLage.Value, 7)
End Sub
Private Sub NettoieLabels()
Label3.Caption = ""
Label4.Caption = ""
End Sub
Function RecupDoublons(T, ColT As Byte) 'Zon
Dim I&, J&, Tablo As New Collection, Temp()
For I = LBound(T, 1) To UBound(T, 1)
On Error Resume Next
Tablo.Add T(I, ColT), CStr(T(I, ColT))
If Err = 0 Then
ReDim Preserve Temp(J)
Temp(J) = T(I, ColT)
J = J + 1
End If
Next I
RecupDoublons = Temp
End Function
Function Equiv2(RechS$, T, Col1 As Byte) 'Zon
Dim I&, J&, K&, Tablo, Temp()
For I = LBound(T) To UBound(T)
If T(I, Col1) = RechS Then
ReDim Preserve Temp(UBound(T, 2) - 1, J) 'Temp est en base 0 pour cela qu'on ôte 1
For K = 0 To UBound(T, 2) - 1
Temp(K, J) = T(I, K + 1) 'T est en Base 1
Next K
J = J + 1
End If
Next I
Equiv2 = Temp
End Function
'
'On construit un tableau à l'envers dans Equiv2 il faut l'inverser
Function InverseTab(T, Optional Base As Byte = 0) 'Zon
Dim Temp(), I&, J&
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For I = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(I, J) = T(J, I)
Next J
Next I
InverseTab = Temp
End Function
A+++
Petchy
