Combobox dependiente mostrar valores únicos
Para Dante Amor
¿Hola Dan como estas?
Te quería molestar otra vez
Tengo el siguiente código que me ayudaste hace rato en esto
Lo que pasa es que tengo dos combobox ...
ComboBoxMaterial y ComboBoxLote
Al buscar en el comboboxMaterial este llena el comboboxlote
Lo que quiero es que el comboboxlote solo aparezcan valores únicos "No repetidos"
Este es el código del comboboxMaterial
Por favor
Muchas gracias
Private Sub ComboBoxMaterial_Change()
Application.ScreenUpdating = False
On Error Resume Next
Dim myrange As Range, i As Integer, Celdi As Range, NameCeldi
'ComboBoxLote.Clear
Set h = Sheets("BD")
Set b = h.Columns("A").Find(ComboBoxMaterial, lookat:=xlWhole)
If Not b Is Nothing Then
LabelUM = h.Cells(b.Row, "C")
LabelTB = h.Cells(b.Row, "B")
LabelUB = h.Cells(b.Row, "D")
End If
i = Sheets("Registros").Range("A" & Rows.Count).End(xlUp).Row
Set myrange = Sheets("Registros").Range("A2:A" & i)
ComboBoxLote.Clear
Set Celdi = myrange.Find(What:=ComboBoxMaterial.Text)
If Not Celdi Is Nothing Then
NameCeldi = Celdi.Address
Do
With ComboBoxLote
.AddItem Sheets("Registros").Range("B" & Celdi.Row)
.Column(1, .ListCount - 1) = Celdi.Row
End With
Set Celdi = myrange.FindNext(Celdi)
Loop While Not Celdi Is Nothing And Celdi.Address <> NameCeldi
End If
If ComboBoxLote.ListCount > 0 Then
With ComboBoxLote
.Visible = True
.ListIndex = 0
End With
Else
nuevo
End If
Application.ScreenUpdating = True
End Sub'
este es el codigo del comboboxLote
Private Sub ComboBoxLote_Change()
Application.ScreenUpdating = False
On Error Resume Next
Hoja4.Select
On Error Resume Next
Label28 = ""
Fila = Sheets("Registros").Range("A" & Rows.Count).End(xlUp).Row
If ComboBoxLote.ListCount > 0 Then
Fila = ComboBoxLote.List(ComboBoxLote.ListIndex, 1)
If Cells(Fila, "D") = Format(Cells(Fila, "D"), "DD-MM-YY") Then
Label28 = ("No existe fecha para este lote")
CalendarioVEN = Hoja4.Cells(Fila, "D")
LabelUM = Hoja4.Cells(Fila, "I")
LabelUB = Hoja4.Cells(Fila, "J")
LabelTB = Hoja4.Cells(Fila, "H")
LabelUB = Format(Hoja4.Cells(Fila, "J"), "DD-MM-YY")
Else
CalendarioVEN = Hoja4.Cells(Fila, "D")
Set h = Sheets("BD")
Set b = h.Columns("A").Find(ComboBoxMaterial, lookat:=xlWhole)
If Not b Is Nothing Then
LabelUM = h.Cells(b.Row, "C")
LabelTB = h.Cells(b.Row, "B")
LabelUB = h.Cells(b.Row, "D")
LabelUB = Format(LabelUB, "DD-MM-YY")
End If
'CalendarioVEN = Hoja4.Cells(Fila, "D")
'LabelUM = Hoja4.Cells(Fila, "I")
'LabelUB = Hoja4.Cells(Fila, "J")
'LabelTB = Hoja4.Cells(Fila, "H")
End If
End If
End Sub
1 respuesta
Respuesta de Dante Amor
2
H o l a:
Cambia el código del evento ComboBoxMaterial_Change por estos 2 códigos:
Private Sub ComboBoxMaterial_Change()
Application.ScreenUpdating = False
On Error Resume Next
Dim myrange As Range, i As Integer, Celdi As Range, NameCeldi
'ComboBoxLote.Clear
Set h = Sheets("BD")
Set b = h.Columns("A").Find(ComboBoxMaterial, lookat:=xlWhole)
If Not b Is Nothing Then
LabelUM = h.Cells(b.Row, "C")
LabelTB = h.Cells(b.Row, "B")
LabelUB = h.Cells(b.Row, "D")
LabelUB = Format(LabelUB, "DD-MM-YY")
End If
'
Set h1 = Sheets("Registros")
i = h1.Range("A" & Rows.Count).End(xlUp).Row
Set r = h1.Range("A2:A" & i)
ComboBoxLote.Clear
Set Celdi = r.Find(What:=ComboBoxMaterial.Text)
If Not Celdi Is Nothing Then
NameCeldi = Celdi.Address
Do
'With ComboBoxLote
' .AddItem h1.Range("B" & Celdi.Row)
' .Column(1, .ListCount - 1) = Celdi.Row
'End With
agregarcombo ComboBoxLote, h1.Range("B" & Celdi.Row), Celdi.Row
Set Celdi = r.FindNext(Celdi)
Loop While Not Celdi Is Nothing And Celdi.Address <> NameCeldi
End If
If ComboBoxLote.ListCount > 0 Then
With ComboBoxLote
.Visible = True
.ListIndex = 0
End With
Else
nuevo
End If
Application.ScreenUpdating = True
End Sub
'
Sub agregarcombo(combo As ComboBox, dato As String, fila)
'por.Dante Amor
For i = 0 To combo.ListCount - 1
Select Case StrComp(combo.List(i), dato, vbTextCompare)
Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega
Case 1
combo.AddItem dato, i
combo.Column(1, combo.ListCount - 1) = fila
Exit Sub 'Es menor, lo agrega antes del comparado
End Select
Next
combo.AddItem dato 'Es mayor lo agrega al final
combo.Column(1, combo.ListCount - 1) = fila
End SubEl código del evento ComboBoxLote_Change, no lo modifiqué.
Prueba y me comentas.
