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
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
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
Esto puede ayudar en algo también
https://www.programarexcel.com/2013/05/llenar-listbox-de-varias-columnas-con.html