Anónimo
Vincular 2 ComoBox en 1 UserForm con VBA (Excel 2007)
Hola. No he podido vincular 2 ComoBox. Tengo un UserForm con 2 ComboBox. El objetivo es que en el primer ComboBox se desplegue "Capitales" y una vez que el ComboBox1 haya hecho Change, el ComboBox2 (con Enabled = True) muestre "Pueblos" asociados a esas "Capitales".
Operativamente, en Hoja1 (A1:A8) están las Capitales (con algunos registros repetidos) y en Hoja1(B1:B8) estàn los pueblos. Estoy ocupando el siguiente còdigo para el primer ComboBox1.
Option Explicit
' This example is based on a tip by J.G. Hussey,
' published in "Visual Basic Programmer's Journal"
Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
' The items are in A1:A105
Set AllCells = Hoja1.Range("A1:A8")
' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell
' Resume normal error handling
On Error GoTo 0
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
UserForm1.ComboBox1.AddItem Item
Next Item
' Show the UserForm
UserForm1.Show
End Sub
Desde ya GRACIAS!
Operativamente, en Hoja1 (A1:A8) están las Capitales (con algunos registros repetidos) y en Hoja1(B1:B8) estàn los pueblos. Estoy ocupando el siguiente còdigo para el primer ComboBox1.
Option Explicit
' This example is based on a tip by J.G. Hussey,
' published in "Visual Basic Programmer's Journal"
Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
' The items are in A1:A105
Set AllCells = Hoja1.Range("A1:A8")
' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell
' Resume normal error handling
On Error GoTo 0
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
UserForm1.ComboBox1.AddItem Item
Next Item
' Show the UserForm
UserForm1.Show
End Sub
Desde ya GRACIAS!
1 respuesta
Respuesta de edwinhenao
1
Puedes usar las herramientas de Excel y ahorrarte un poco de código... por ejemplo el quitar duplicados de Excel 2007... Si armas la lista de capitales, y en rangos aledaños las listas de pueblos puedes cargar los ComboBox con RowSource y Select Case...
...
Private Sub UserForm_Activate()
ComboBox2.Enabled = False
End Sub
...........................
Private Sub ComboBox1_Change()
ComboBox2.Enabled = True
Select Case ComboBox1.ListIndex
Case 0
ComboBox2.RowSource = "C2:C5"
Case 1
ComboBox2.RowSource = "D2:D8"
Case 2
ComboBox2.RowSource = "E2:E7"
Case 3
ComboBox2.RowSource = "F2:F4"
End Select
End Sub
...
Ya si lo que necesitas es una macro que saque las listas yo lo haría con quitar duplicados y filtros avanzados... Para quitar los duplicados utiliza:
...
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
Para los filtros avanzados es indispensable que las columnas en la Hoja1 tengan títulos, algo así como Capitales y Pueblos en tu caso... Prueba con esta macro...
...
Private Sub UserForm_Activate()
ComboBox2.Enabled = False
Sheets("Hoja1").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
RangoBaseDatos = Selection.Address
ActiveWorkbook.Sheets.Add
HojaTrabajo = ActiveSheet.Name
Sheets("Hoja1").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(HojaTrabajo).Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.DisplayAlerts = False
cuantos = Selection.Count
Selection.Offset(-1, 0).Value = "Capitales"
Selection.Offset(1, 0).Value = "Pueblos"
Range("A3").Select
For i = 1 To cuantos
Sheets("Hoja1").Range(RangoBaseDatos).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range(Cells(1, i + 1), Cells(2, i + 1)), CopyToRange:=Cells(3, i + 1), Unique:=False
Next i
Range("B1:B3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
ElComboUno = Selection.Address
ComboBox1.RowSource = ElComboUno
Application.DisplayAlerts = True
End Sub
..........
Ya deja el ComboBox1 cargado y con la macro ComboBox1_Change() caragas el 2.... algo así:
Private Sub ComboBox1_Change()
ComboBox2.Enabled = True
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
cuantos = Selection.Count
For i = 0 To cuantos
Select Case ComboBox1.ListIndex
Case i
Columns(i + 2).Select
Range(Cells(1, i + 2), Cells(1, i + 2)).Select
If Not IsEmpty(ActiveCell.Offset(1, 0).Value) Then
Range(Selection, Selection.End(xlDown)).Select
RangoParaComboBox2 = Selection.Address
ComboBox2.RowSource = RangoParaComboBox2
Else
RangoParaComboBox2 = Selection.Address
ComboBox2.RowSource = RangoParaComboBox2
End If
End Select
Next
End Sub
...
Private Sub UserForm_Activate()
ComboBox2.Enabled = False
End Sub
...........................
Private Sub ComboBox1_Change()
ComboBox2.Enabled = True
Select Case ComboBox1.ListIndex
Case 0
ComboBox2.RowSource = "C2:C5"
Case 1
ComboBox2.RowSource = "D2:D8"
Case 2
ComboBox2.RowSource = "E2:E7"
Case 3
ComboBox2.RowSource = "F2:F4"
End Select
End Sub
...
Ya si lo que necesitas es una macro que saque las listas yo lo haría con quitar duplicados y filtros avanzados... Para quitar los duplicados utiliza:
...
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
Para los filtros avanzados es indispensable que las columnas en la Hoja1 tengan títulos, algo así como Capitales y Pueblos en tu caso... Prueba con esta macro...
...
Private Sub UserForm_Activate()
ComboBox2.Enabled = False
Sheets("Hoja1").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
RangoBaseDatos = Selection.Address
ActiveWorkbook.Sheets.Add
HojaTrabajo = ActiveSheet.Name
Sheets("Hoja1").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(HojaTrabajo).Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.DisplayAlerts = False
cuantos = Selection.Count
Selection.Offset(-1, 0).Value = "Capitales"
Selection.Offset(1, 0).Value = "Pueblos"
Range("A3").Select
For i = 1 To cuantos
Sheets("Hoja1").Range(RangoBaseDatos).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range(Cells(1, i + 1), Cells(2, i + 1)), CopyToRange:=Cells(3, i + 1), Unique:=False
Next i
Range("B1:B3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
ElComboUno = Selection.Address
ComboBox1.RowSource = ElComboUno
Application.DisplayAlerts = True
End Sub
..........
Ya deja el ComboBox1 cargado y con la macro ComboBox1_Change() caragas el 2.... algo así:
Private Sub ComboBox1_Change()
ComboBox2.Enabled = True
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
cuantos = Selection.Count
For i = 0 To cuantos
Select Case ComboBox1.ListIndex
Case i
Columns(i + 2).Select
Range(Cells(1, i + 2), Cells(1, i + 2)).Select
If Not IsEmpty(ActiveCell.Offset(1, 0).Value) Then
Range(Selection, Selection.End(xlDown)).Select
RangoParaComboBox2 = Selection.Address
ComboBox2.RowSource = RangoParaComboBox2
Else
RangoParaComboBox2 = Selection.Address
ComboBox2.RowSource = RangoParaComboBox2
End If
End Select
Next
End Sub