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

El código del evento ComboBoxLote_Change, no lo modifiqué.

Prueba y me comentas.


Añade tu respuesta

Haz clic para o

Más respuestas relacionadas