Combobox dependiente sin repetir datos

Estoy haciendo un formulario para encontrar características de equipos, para ello he decidido agruparlos en varias categorías, área, equipo, sistema, componente y elemento de esta manera es más fácil encontrar un elemento y la información que se necesita de él. He elaborado una sola hoja donde cada columna corresponde a una categoría de las mencionadas anteriormente. Para el caso del primer filtro he usado el siguiente código con el cual cargo la información sin repetir datos

For Each celda In Range("c3:c" & Range("c65000").End(xlUp).Row)
If InStr(valores, celda) = 0 Then
valores = valores & "," & celda.Value
End If
Next
valores = Mid(valores, 2, Len(valores) - 1)
valores = Split(valores, ",")
For x = 0 To UBound(valores)
ComboBox1.AddItem valores(x)
Next

Ahora la pregunta es como hago para cargar el siguiente combobox ya que debería cargar en base a la selección del primero. Debería entonces buscar en la columna C aquellas filas que tengan el mismo valor de la selección y luego agregarlo sin repetir datos, para el tercer combobox debería seria similar ya que debería tomar los datos de la columna e que cumplan con el combobox 1, luego que además cumplan con el combobox 2 y finalmente que no estén repetidos

3 Respuestas

Respuesta
1

Adjunto archivo excel un ejemplo de anidar 3 tablas en combobox según las condiciones que planteas, para que puedas adaptarlo a tu caso.

Espero que te sirva de mucha ayuda, cualquier consulta estaré atento.

Por favor, recuerda valorar la respuesta, muchas gracias.

https://drive.google.com/file/d/1C9vt53liaJoByLFfYl2790AQeEeJzfVZ/view 

Respuesta
1

Es bastante fácil hacer ese tipo de listas dependientes cuando entiendes la programación orientada a objetos, ve el ejemplo, cada combo crea en la región de datos que graba en la hoja de excel y el siguiente combo usa esa región para ir filtrando la información hasta quedar como en se muestra en la pnantalla.

y este es el código, lo único que tienes que hacer es modificar estos datos Set DATOS = Range("A1"). CurrentRegion
With ActiveWorkbook.Worksheets("Hoja1")

cambia el a1 y hoja1 adecuandolo a tus datos

Private Sub ComboBox1_Change()
Dim UNICOS As New Collection
Dim FUNCION As WorksheetFunction
Set FUNCION = WorksheetFunction
Set Areas = Range("AREAS")
AREA = ComboBox1.Value
With Areas
    CUENTA = FUNCION.CountIf(.Columns(1), AREA)
    If CUENTA = 0 Then GoTo SALIDA
    F = FUNCION.Match(AREA, .Columns(1), 0)
    Set EQUIPOS = .Rows(F).Resize(CUENTA)
   ComboBox2.Clear
    With EQUIPOS
        filas = .Rows.Count: columnas = .Columns.Count
        For i = 1 To filas
            EQUIPO = .Cells(i, 2)
            On Error Resume Next
            UNICOS.Add EQUIPO, CStr(EQUIPO)
            If Err.Number = 0 Then ComboBox2.AddItem EQUIPO
            On Error GoTo 0
        Next i
        .Name = "EQUIPOS"
    End With
End With
Set EQUIPOS = Nothing: Set Areas = Nothing
SALIDA:
End Sub
Private Sub ComboBox2_Change()
Dim UNICOS As New Collection
Dim FUNCION As WorksheetFunction
Set FUNCION = WorksheetFunction
Set EQUIPOS = Range("EQUIPOS")
ComboBox3.Clear
EQUIPO = ComboBox2.Value
With EQUIPOS
    CUENTA = FUNCION.CountIf(.Columns(2), EQUIPO)
    If CUENTA = 0 Then GoTo SALIDA:
    FILA = FUNCION.Match(EQUIPO, .Columns(2), 0)
    Set SISTEMAS = .Rows(FILA).Resize(CUENTA)
        With SISTEMAS
        F = .Rows.Count: c = .Columns.Count
        For i = 1 To F
            SISTEMA = .Cells(i, 3)
            On Error Resume Next
            UNICOS.Add SISTEMA, CStr(SISTEMA)
            If Err.Number = 0 Then ComboBox3.AddItem SISTEMA
            On Error GoTo 0
        Next i
        .Name = "SISTEMAS"
        End With
End With
Set SISTEMAS = Nothing: Set EQUIPOS = Nothing
SALIDA:
End Sub
Private Sub ComboBox3_Change()
Dim UNICOS As New Collection
Dim FUNCION As WorksheetFunction
Set FUNCION = WorksheetFunction
Set SISTEMAS = Range("SISTEMAS")
ComboBox4.Clear
SISTEMA = ComboBox3.Value
With SISTEMAS
    CUENTA = FUNCION.CountIf(.Columns(3), SISTEMA)
    If CUENTA = 0 Then GoTo SALIDA:
    F = FUNCION.Match(SISTEMA, .Columns(3), 0)
    Set COMPONENTES = .Rows(F).Resize(CUENTA)
    With COMPONENTES
        filas = .Rows.Count: columnas = .Columns.Count
        For i = 1 To filas
            COMP = .Cells(i, 4)
            On Error Resume Next
                UNICOS.Add COMP, CStr(COMP)
                If Err.Number = 0 Then ComboBox4.AddItem COMP
            On Error GoTo 0
        Next i
        .Name = "COMPONENTES"
    End With
End With
Set SISTEMAS = Nothing: Set COMPONENTES = Nothing
SALIDA:
End Sub
Private Sub ComboBox4_Change()
Dim UNICOS As New Collection
Dim FUNCION As WorksheetFunction
Set FUNCION = WorksheetFunction
Set COMPONENTES = Range("COMPONENTES")
ComboBox5.Clear
COMP = ComboBox4.Value
With COMPONENTES
    CUENTA = FUNCION.CountIf(.Columns(4), COMP)
    If CUENTA = 0 Then GoTo SALIDA
    F = FUNCION.Match(COMP, .Columns(4), 0)
    Set elementos = .Rows(F).Resize(CUENTA)
    With elementos
        filas = .Rows.Count: columnas = .Columns.Count
        For i = 1 To filas
            elem = .Cells(i, 5)
            On Error Resume Next
            UNICOS.Add elem, CStr(elem)
            If Err.Number = 0 Then ComboBox5.AddItem elem
            On Error GoTo 0
        Next i
        .Select
    End With
End With
Set elementos = Nothing: Set COMPONENTES = Nothing
SALIDA:
End Sub
Private Sub ComboBox5_Change()
End Sub
Private Sub UserForm_Initialize()
    Dim UNICOS As New Collection
    ComboBox1.Clear
    Set DATOS = Range("A1").CurrentRegion
    ' ORDENA LAS 5 COLUMNAS DE DATOS
    With ActiveWorkbook.Worksheets("Hoja1")
        .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(1).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(2).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(3).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(4).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(5).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range(DATOS.Address)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
    'CARGA DATOS EN EL COMBOBOX SIN REPETIDOS
With DATOS
    filas = .Rows.Count: columnas = .Columns.Count
    For i = 2 To filas
        AREA = .Cells(i, 1)
        On Error Resume Next
        UNICOS.Add AREA, CStr(AREA)
        If Err.Number = 0 Then ComboBox1.AddItem AREA
        On Error GoTo 0
    Next i
    .Name = "AREAS"
    .CurrentRegion.EntireColumn.AutoFit
End With
Set DATOS = Nothing
End Sub

Muchas gracias por el código, he aprendido de forma empírica a programar un poco en excel, sobre todo cosas matemáticas que son más sencillas porque usas bucles o fórmulas, tomas valores de celdas y así. Puedes explicarme un poco como funciona te lo agradecería mucho, de igual forma no he logrado hacerlo trabajar porque no se como funciona.

Trabajo en la hoja 2, en la fila 2 están los encabezados, la columna 2 se llama planta, la 4 es área, la 6 es equipo, la 8 es sistema, la 10 es elemento y finalmente la 12 es componente. En las columnas impares hay código para cada área para trabajarlo posteriormente.

Supuse que algo así pasaría al no tener información de que ocupas exactamente, hice la programación basándose en suposiciones, esta es la imagen con el resultado de la macro, la macro funciona así, al abrir el formulario te va a ordenar por columnas agrupando plantas, luego dentro de cada planta las áreas, luego dentro de cada área de cada plantas los equipos y así sucesivamente, después mediante un objeto llamado New Collection (ÚNICOS) va a realizar el primer filtro en este caso las plantas repetidas y solo va a cargar en el combobox 1 registros no repetidos, toda esa área de trabajo la va a grabar en la hoja de excel con el nombre plantas, luego el segundo filtra mandara llamar la región llamada plantas y ahora filtrara según la planta que elijas en el combobox empleando además del objeto new collection dos funciones contar y coincidir que buscaran en la columna 1 cuantas plantas hay del valor que seleccionaste y a partir de que fila comienzan, hace el filtro como ya explique y lo graba con el nombre de áreas en la hoja de Excel, y así sucesivamente la macro ira trabajando con áreas de datos cada vez más pequeñas hasta llegar al elemento, cada que reduce un área la va asignando al Excel y la usa con el siguiente combobox, esto te permite regresarte a cualquier combobox y hacer el filtro desde ese combobox sin mayor problema

y esta es la macro 

Private Sub ComboBox1_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
PLANTA = ComboBox1.Value
Set PLANTAS = Range("PLANTAS")
ComboBox2.Clear
With PLANTAS
    CUENTA = X.CountIf(.Columns(1), PLANTA)
    If CUENTA = 0 Then GoTo SALIDA
    FILA = X.Match(PLANTA, .Columns(1), 0)
    Set Areas = .Rows(FILA).Resize(CUENTA)
    With Areas
        F = .Rows.Count: C = .Columns.Count
        For I = 1 To F
            AREA = .Cells(I, 3)
            On Error Resume Next
            UNICOS.Add AREA, CStr(AREA)
            If Err.Number = 0 Then ComboBox2.AddItem AREA
            On Error GoTo 0
        Next I
        .Name = "AREAS"
    End With
End With
Set PLANTAS = Nothing: Set Areas = Nothing
SALIDA:
End Sub
Private Sub ComboBox2_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
AREA = ComboBox2.Value
Set Areas = Range("AREAS")
ComboBox3.Clear
With Areas
    CUENTA = X.CountIf(.Columns(3), AREA)
    If CUENTA = 0 Then GoTo SALIDA
    FILA = X.Match(AREA, .Columns(3), 0)
    Set EQUIPOS = .Rows(FILA).Resize(CUENTA)
    With EQUIPOS
        F = .Rows.Count: C = .Columns.Count
        For I = 1 To F
            EQUIPO = .Cells(I, 5)
            On Error Resume Next
            UNICOS.Add EQUIPO, CStr(EQUIPO)
            If Err.Number = 0 Then ComboBox3.AddItem EQUIPO
            On Error GoTo 0
        Next I
        .Name = "EQUIPOS"
    End With
End With
Set EQUIPOS = Nothing: Set Areas = Nothing
SALIDA:
End Sub
Private Sub ComboBox3_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
EQUIPO = ComboBox3.Value
Set EQUIPOS = Range("EQUIPOS")
ComboBox4.Clear
With EQUIPOS
    CUENTA = X.CountIf(.Columns(5), EQUIPO)
    If CUENTA = 0 Then GoTo SALIDA
    FILA = X.Match(EQUIPO, .Columns(5), 0)
    Set SISTEMAS = .Rows(FILA).Resize(CUENTA)
    With SISTEMAS
        F = .Rows.Count: C = .Columns.Count
        For I = 1 To F
            SISTEMA = .Cells(I, 7)
            On Error Resume Next
            UNICOS.Add SISTEMA, CStr(SISTEMA)
            If Err.Number = 0 Then ComboBox4.AddItem SISTEMA
            On Error GoTo 0
        Next I
        .Name = "SISTEMAS"
    End With
End With
Set EQUIPOS = Nothing: Set SISTEMAS = Nothing
SALIDA:
End Sub
Private Sub ComboBox4_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
SISTEMA = ComboBox4.Value
Set SISTEMAS = Range("SISTEMAS")
ComboBox5.Clear
With SISTEMAS
    CUENTA = X.CountIf(.Columns(7), SISTEMA)
    If CUENTA = 0 Then GoTo SALIDA
    FILA = X.Match(SISTEMA, .Columns(7), 0)
    Set COMPONENTES = .Rows(FILA).Resize(CUENTA)
    With COMPONENTES
        F = .Rows.Count: C = .Columns.Count
        For I = 1 To F
            COMP = .Cells(I, 9)
            On Error Resume Next
            UNICOS.Add COMP, CStr(COMP)
            If Err.Number = 0 Then ComboBox5.AddItem COMP
            On Error GoTo 0
        Next I
        .Name = "COMPONENTES"
    End With
End With
Set COMPONENTES = Nothing: Set SISTEMAS = Nothing
SALIDA:
End Sub
Private Sub ComboBox5_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
COMP = ComboBox5.Value
Set COMPONENTES = Range("COMPONENTES")
ComboBox6.Clear
With COMPONENTES
    CUENTA = X.CountIf(.Columns(9), COMP)
    If CUENTA = 0 Then GoTo SALIDA
    FILA = X.Match(COMP, .Columns(9), 0)
    Set ELEMENTOS = .Rows(FILA).Resize(CUENTA)
    With ELEMENTOS
        F = .Rows.Count: C = .Columns.Count
        .Select
        For I = 1 To F
            ELEM = .Cells(I, 11)
            On Error Resume Next
            UNICOS.Add ELEM, CStr(ELEM)
            If Err.Number = 0 Then ComboBox6.AddItem ELEM
            On Error GoTo 0
        Next I
        .Name = "ELEMENTOS"
    End With
End With
Set COMPONENTES = Nothing: Set ELEMENTOS = Nothing
SALIDA:
End Sub
Private Sub UserForm_Initialize()
    Dim UNICOS As New Collection
    ComboBox1.Clear
    Set DATOS = Range("B2").CurrentRegion
    ' ORDENA LAS 5 COLUMNAS DE DATOS
    With ActiveWorkbook.Worksheets("Hoja1")
        .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(1).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(3).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(5).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(7).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(9).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(DATOS.Columns(11).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range(DATOS.Address)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
    'CARGA DATOS EN EL COMBOBOX SIN REPETIDOS
With DATOS
    filas = .Rows.Count: columnas = .Columns.Count
    For I = 2 To filas
        PLANTA = .Cells(I, 1)
        On Error Resume Next
        UNICOS.Add PLANTA, CStr(PLANTA)
        If Err.Number = 0 Then ComboBox1.AddItem PLANTA
        On Error GoTo 0
    Next I
    .Name = "PLANTAS"
    .CurrentRegion.EntireColumn.AutoFit
End With
Set DATOS = Nothing
End Sub

Muchas gracias por la explicación voy a ahondar por la tarde un poco mas, copie y peque el código y queda exactamente como lo requería. Quiero molestarte con un ultimo par de detalles:

1. Como hago para que al cargar el combobox no cargue el encabezado ? ( for i=3 to filas ?) mi encabezado esta en la fila 3 y no en la 2.

Por otro lado cango

carga el combobox 2 aparece un item que es un espacio en blanco, si lo selecciono da error

Cambia en el modulo initialize del formulario b2 por b3 en la instrucción set datos=range("b2"). Currentregion, solo una cosa esta instrucción selecciona todo lo que este alrededor de la celda b3 y crea una región de datos donde b3 sera la columna1 y la fila1, si tienes información en b2 y/o b1 entonces hay que cambiar esa parte de la programación para adaptarlo, respecto al segundo error bien puede ser resultado de que esta cargando el encabezado o bien por alguna razón no se esta cargando el combobox2, sube una pantalla de tus datos como los tienes partiendo de b3 para ver que pede ser.

Buen día, he subido el archivo a la nube tal cual lo llevo. https://drive.google.com/open?id=1Q7IypA-OtzDaR9iPG-a7-SL1zy34m9JV ahí podrás ver lo que te digo, también me dio error por ejemplo al cargar el formulario dos con "Estación de elevación" luego en el formulario 3 elegir por ejemplo bomba 1 y luego en el formulario cambiar a criba. 

El problema son los espacios en blanco y como imagine tienes datos en la columna 1 lo cual modifica el modulo initialize, ya le hice los ajustes para que descarte a la hora de ordernar la fila 1 y para que descarte la fila 2 y 3 al momento de cargar los datos, ahora si la macro encuentra espacios en blanco en los combobox te mostrara mensajes de error.

Private Sub CheckBox8_Click()
CheckBox4.Value = True
CheckBox5.Value = True
CheckBox6.Value = True
CheckBox7.Value = True
CheckBox9.Value = True
End Sub
Private Sub ComboBox1_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
PLANTA = ComboBox1.Value
Set PLANTAS = Range("PLANTAS")
ComboBox2.Clear
With PLANTAS
    CUENTA = X.CountIf(.Columns(1), PLANTA)
    If CUENTA = 0 Then GoTo SALIDA
    FILA = X.Match(PLANTA, .Columns(1), 0)
    Set Areas = .Rows(FILA).Resize(CUENTA)
    With Areas
        f = .Rows.Count: c = .Columns.Count
        For I = 1 To f
            area = .Cells(I, 3)
            On Error Resume Next
            If area <> Empty Then UNICOS.Add area, CStr(area)
            If Err.Number = 0 Then ComboBox2.AddItem area
            On Error GoTo 0
        Next I
        .Name = "AREAS"
    End With
End With
Set PLANTAS = Nothing: Set Areas = Nothing
SALIDA:
End Sub
Private Sub ComboBox2_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
area = ComboBox2.Value
Set Areas = Range("AREAS")
ComboBox3.Clear
With Areas
    CUENTA = X.CountIf(.Columns(3), area)
    If CUENTA = 0 Then GoTo SALIDA
    On Error Resume Next
    FILA = X.Match(area, .Columns(3), 0)
    If Err.Number > 0 Then MsgBox ("NO HAY EQUIPO PARA ESTA PLANTA Y AREA"), _
    vbCritical, "AVISO": GoTo SALIDA
    On Error GoTo 0
    Set EQUIPOS = .Rows(FILA).Resize(CUENTA)
    With EQUIPOS
        f = .Rows.Count: c = .Columns.Count
        For I = 1 To f
            equipo = .Cells(I, 5)
            On Error Resume Next
            If equipo <> Empty Then UNICOS.Add equipo, CStr(equipo)
            If Err.Number = 0 Then ComboBox3.AddItem equipo
            On Error GoTo 0
        Next I
        .Name = "EQUIPOS"
    End With
End With
Set EQUIPOS = Nothing: Set Areas = Nothing
SALIDA:
End Sub
Private Sub ComboBox3_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
equipo = ComboBox3.Value
Set EQUIPOS = Range("EQUIPOS")
ComboBox4.Clear
With EQUIPOS
    CUENTA = X.CountIf(.Columns(5), equipo)
    If CUENTA = 0 Then GoTo SALIDA
    On Error Resume Next
    FILA = X.Match(equipo, .Columns(5), 0)
    If Err.Number > 0 Then MsgBox ("NO HAY SISTEMA ASIGNADO A ESTA PLANTA, " _
    & "AREA Y EQUIPO"), vbCritical, "AVISO": GoTo SALIDA
    On Error GoTo 0
    Set SISTEMAS = .Rows(FILA).Resize(CUENTA)
    With SISTEMAS
        f = .Rows.Count: c = .Columns.Count
        For I = 1 To f
            sistema = .Cells(I, 7)
            On Error Resume Next
            If sistema <> Empty Then UNICOS.Add sistema, CStr(sistema)
            If Err.Number = 0 Then ComboBox4.AddItem sistema
            On Error GoTo 0
        Next I
        .Name = "SISTEMAS"
    End With
End With
Set EQUIPOS = Nothing: Set SISTEMAS = Nothing
SALIDA:
End Sub
Private Sub ComboBox4_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
sistema = ComboBox4.Value
Set SISTEMAS = Range("SISTEMAS")
ComboBox5.Clear
With SISTEMAS
    CUENTA = X.CountIf(.Columns(7), sistema)
    If CUENTA = 0 Then GoTo SALIDA
    On Error Resume Next
    FILA = X.Match(sistema, .Columns(7), 0)
    If Err.Number > 0 Then MsgBox ("NO HAY EQUIPO PARA ESTA PLANTA Y AREA"), _
    vbCritical, "AVISO": GoTo SALIDA
    On Error GoTo 0
    Set COMPONENTES = .Rows(FILA).Resize(CUENTA)
    With COMPONENTES
        f = .Rows.Count: c = .Columns.Count
        For I = 1 To f
            comp = .Cells(I, 9)
            On Error Resume Next
            If comp <> Empty Then UNICOS.Add comp, CStr(comp)
            If Err.Number = 0 Then ComboBox5.AddItem comp
            On Error GoTo 0
        Next I
        .Name = "COMPONENTES"
    End With
End With
Set COMPONENTES = Nothing: Set SISTEMAS = Nothing
SALIDA:
End Sub
Private Sub ComboBox5_Change()
Dim UNICOS As New Collection
Dim X As WorksheetFunction
Set X = WorksheetFunction
comp = ComboBox5.Value
Set COMPONENTES = Range("COMPONENTES")
ComboBox6.Clear
With COMPONENTES
    CUENTA = X.CountIf(.Columns(9), comp)
    If CUENTA = 0 Then GoTo SALIDA
    On Error Resume Next
    FILA = X.Match(comp, .Columns(9), 0)
    If Err.Number > 0 Then MsgBox ("NO HAY EQUIPO PARA ESTA PLANTA Y AREA"), _
    vbCritical, "AVISO": GoTo SALIDA
    On Error GoTo 0
    Set ELEMENTOS = .Rows(FILA).Resize(CUENTA)
    With ELEMENTOS
        f = .Rows.Count: c = .Columns.Count
        .Select
        For I = 1 To f
            ELEM = .Cells(I, 11)
            On Error Resume Next
            If ELEM <> Empty Then UNICOS.Add ELEM, CStr(ELEM)
            If Err.Number = 0 Then ComboBox6.AddItem ELEM
            On Error GoTo 0
        Next I
        .Name = "ELEMENTOS"
    End With
End With
Set COMPONENTES = Nothing: Set ELEMENTOS = Nothing
SALIDA:
End Sub
Private Sub MultiPage1_Change()
End Sub
Private Sub UserForm_Initialize()
    Dim UNICOS As New Collection
    ComboBox1.Clear
    Set datos = Range("a2").CurrentRegion
     With datos
        f = .Rows.Count: c = .Columns.Count
        Set datos = .Rows(2).Resize(f - 1, c)
     End With
    ' ORDENA LAS 5 COLUMNAS DE DATOS
    With ActiveWorkbook.Worksheets("Hoja1")
        .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range(datos.Columns(1).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(datos.Columns(3).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(datos.Columns(5).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(datos.Columns(7).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(datos.Columns(9).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range(datos.Columns(11).Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range(datos.Address)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
    'CARGA DATOS EN EL COMBOBOX SIN REPETIDOS
With datos
    filas = .Rows.Count: columnas = .Columns.Count
    Set datos = .Rows(3).Resize(filas - 2, columnas)
    For I = 1 To filas
        PLANTA = .Cells(I, 1)
        On Error Resume Next
        UNICOS.Add PLANTA, CStr(PLANTA)
        If Err.Number = 0 Then ComboBox1.AddItem PLANTA
        On Error GoTo 0
    Next I
    .Name = "PLANTAS"
    .CurrentRegion.EntireColumn.AutoFit
End With
Set datos = Nothing
End Sub

La macro anda muy bien, una ultima consulta. Digamos que elijo en el combobox 2 cribado y en el 3 elijo criba, como ya vi lo que quería de la criba ahora me voy en el combobox 2 a estación de elevación, porque me tira error de que no hay sistema asignado a esta planta ? veo que en general si ya seleccione un combobox y modifico uno que este antes, da como resultado un error porque pareciera que no refresca.

Es por lo siguiente cuando has seleccionado un valor en el combobox2 (criba) y en el combobox3(cribado) y luego seleccionas en el combobox2(elevación) en el combobox3 se queda con el valor cribado y como los eventos del combobox se activan cuando detectan un cambio en cualquiera de los combobox, la macro busca elevación y luego cribado al no encontrarlo te envía ese mensaje de error, después de ese mensaje la macro borra el combobox3 y lo actualiza ajustándose a los datos contenidos en el combobox2 en este caso elevación, la solución quita los msgbox sino los ocupas.

Realmente estoy muy agradecido, muy bien explicado, es exactamente lo que necesitaba, gracias por tomarte el tiempo, no cualquiera.

Entonces solo queda que evalúes mi respuesta

Respuesta
1

Esto puede ayudar en algo también

https://youtu.be/2NH4sB_KnWM

https://youtu.be/KCHAk9-dAPM

https://youtu.be/7c7mV8fe4sw

https://youtu.be/sWrUt9kItsg

https://www.programarexcel.com/2013/05/llenar-listbox-de-varias-columnas-con.html 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

¿Cómo separo dos números que se encuentran en una sola celda de excel?

En una celda de excel se encuentran dos cantidades separadas por un guion. Quisiera separar el primer número en una segunda celda y el segundo número en una tercer celda. Ejemplo: A 1 48,264 - 65,371 2 55,555 - 66,666 3 . . . Debería quedar así: A B...
2 respuestas

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

Gráfico Comparativo por Semanas, en Power Bi.

Espero se encuentren muy bien. Tengo una tabla en Power BI con fechas, códigos, costos y cantidades. La necesidad que tengo es de crear un gráfico o tabla donde pueda comparar y analizar el comportamiento de los costos y las cantidades de un código...
1 respuesta

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Como evitar que se duplique un dato en la base de datos

Trato que al ingresar los datos a la base de datos si en la columna "B" DNI es una cifra que ya esta en dicha base me lo indique en un Msgbox "El Dato ya existe" Esta es la macro que tengo en el botón Aceptar Private Sub Aceptar_Click()...
2 respuestas

Detectar si he marcado Celda dentro de un Rango de Excel.

Tengo un Rango en Hoja Excel: RgoDatos >> $B$3:$V$39 Quiero detectar si la celda que selecciono está dentro de ese Rango Si no está que por omisión me marque B3.
1 respuesta

Desproteger un rango de celdas en una hoja protegida

Tengo una aplicación donde en una hoja se ponen comentarios automáticos con una macro, pero como hay celdas donde hay fórmulas las tengo bloqueadas y ocultas para que no se borren por error al usarla, tengo puesto el Unprotect en la macro por que si...
8 respuestas

Dato fecha ya existe en tabla

Como están estimados maestros. En formulario, tengo botón archivar. Envío información a hoja "existencias" a tabla "tbl_existencias". En columna A un Código desde textbox1 En columna B fecha desde textbox "txtFecha2" En columna C total desde textbox2...
2 respuestas