Según mi ejemplo, dirígete al código del botón Filtrar y reemplaza el texto If Cells(i, j).Offset(0, 2).Value = CInt(Me.txtFiltro1.Value) Then Por este If LCase(Cells(i, j).Offset(0, 2).Value) Like "*" & LCase(Me.txtFiltro1.Value) & "*" Then
En el formulario buscar reemplaza la línea If Cells(i, j).Offset(0, 2).Value = CInt(Me.txtFiltro1.Value) Then
por esta If Cells(i, j).Value = CInt(Me.txtFiltro1.Value) Then
Las siguientes lineas hay que comentarlas o borrarlas Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(i, j).Offset(0, 2) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(i, j).Offset(0, 3)
En el formulario Modificar hay que ponerle un 2 a la siguiente línea For i = 1 To 2
ROGRAMA COMPLETO
Codigo VBA para un Listbox con mas de 10 columnas Estoy trabajando con un UserForm el cual contiene un listBox en el que cargo una base de datos por medio un filtro. fil tro. El problema que me presenta el listBox l istBox es que no me carga mas de 10 columnas y necesito cargar 26.
Les agradezco su ayuda y asesoría para solucionar dicho error. Anexo para el código para su revisión.
'Cambia el TextBox con cada cambio en el Combo ' Private Sub cmbEncabezad cmbEncabezado_Change() o_Change() Me.lblFiltro = "Filtro por " & Me.cmbEncabe Me.cmbEncabezado.Value zado.Value
End Sub ' 'Cerrar formulario Private Sub CommandButton2_Click() Unload Me End Sub ' ' 'Mostrar resultado en ListBox Private Sub CommandButton5_Click() On Error GoTo Errores If Me.txtFiltro1.Value = "" Then Exit Sub Me.ListBox1.Clear Columna = Me.cmbEncabezado.ListIndex j = 1 Filas = Range("a1").CurrentRegion.Rows.Count For i = 1 To Filas If LCase(Cells(i, j).Offset(0, CInt(Columna)).Value) Like "*" & LCase(Me.txtFiltro1.Value) & "*" Then Me.ListBox1.AddItem Cells(i, j) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, j).Offset(0, 1) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(i, j).Offset(0, 2) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(i, j).Offset(0, 3) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Cells(i, j).Offset(0, 4) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Cells(i, j).Offset(0, 5) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Cells(i, j).Offset(0, 6) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = Cells(i, j).Offset(0, 7) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = Cells(i, j).Offset(0, 8) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = Cells(i, j).Offset(0, 9) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 10) = Cells(i, j).Offset(0, 10) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 11) = Cells(i, j).Offset(0, 11) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 12) = Cells(i, j).Offset(0, 12) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 13) = Cells(i, j).Offset(0, 13)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 14) = Cells(i, j).Offset(0, 14) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 15) = Cells(i, j).Offset(0, 15) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 16) = Cells(i, j).Offset(0, 16) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 17) = Cells(i, j).Offset(0, 17) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 18) = Cells(i, j).Offset(0, 18) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 19) = Cells(i, j).Offset(0, 19) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 20) = Cells(i, j).Offset(0, 20) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 21) = Cells(i, j).Offset(0, 21) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 22) = Cells(i, j).Offset(0, 22) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 23) = Cells(i, j).Offset(0, 23) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 24) = Cells(i, j).Offset(0, 24) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 25) = Cells(i, j).Offset(0, 25) Else End If Next i Exit Sub Errores: MsgBox "No se encuentra.", vbExclamation, "EXCELeINFO" End Sub
'Activar la celda del registro elegido Private Sub ListBox1_Click() Range("a2").Activate Cuenta = Me.ListBox1.ListCount Set Rango = Range("A1").CurrentRegion For i = 0 To Cuenta - 1 If Me.ListBox1.Selected(i) Then Valor = Me.ListBox1.List(i) Rango.Find(What:=Valor, LookAt:=xlWhole, After:=ActiveCell).Activate End If Next i End Sub '
'Dar formato al ListBox y traer los encabezados de la tabla Private Sub UserForm_Initialize() ' For i = 1 To 26 Me.Controls("Label" & i) = Cells(1, i).Value Next i ' With Me .ListBox1.ColumnCount = 26 .ListBox1.ColumnWidths = "30 pt;55 pt;50 pt;55 pt;75 pt;65 pt;45 pt;45 pt;50 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt" .cmbEncabezado.List = Application.Transpose(ActiveCell.CurrentRegion.Resize(1).Value) .cmbEncabezado.ListStyle = fmListStyleOption End With End Sub
TEMAS DE MACROS Los códigos VBA de nuestra macro son: Sub copiados() Dim HojaOrigen As Worksheet, HojaDestino As Worksheet Set HojaOrigen = Sheets(1) Set HojaDestino = Sheets(2) 'con el If compruebo las condiciones previas a la ejecución del copiado y pegado If HojaOrigen.Cells(2, 1).Value <> Empty And _ HojaOrigen.Cells(3, 1).Value <> Empty Then Application.ScreenUpdating = False 'una forma empleando el método .Paste, con dos parámetros incompatibles 'o bien definimos Destination o bien Link HojaOrigen.Cells(2, 1).Copy ActiveSheet.Paste HojaDestino.Range("A2") 'con Link realiza un Pegar vínculo HojaOrigen.Cells(3, 1).Copy HojaDestino.Range("A3").Activate ActiveSheet.Paste link:=True 'Realizamos un Pegado especial, en este caso como Pegar valores y Pegar fórmulas HojaOrigen.Cells(2, 2).Copy HojaDestino.Cells(2, 2).PasteSpecial Paste:=xlValues HojaOrigen.Cells(3, 2).Copy HojaDestino.Cells(3, 2).PasteSpecial Paste:=xlFormulas 'Con el método .Copy podemos indicar dónde deseamos nos copie el rango seleccionado 'realiza un copiado exacto (con formatos, fórmulas, etc)
HojaOrigen.Cells(2, 3).Copy Destination:=HojaDestino.Cells(2, 3) HojaOrigen.Cells(3, 3).Copy Destination:=HojaDestino.Cells(3, 3) 'También podemos vincular valores o fórmulas relacionando diferentes celdas. HojaDestino.Range("D2").Value = HojaOrigen.Range("D2").Value HojaDestino.Range("D3").Formula = HojaOrigen.Range("D3").Formula Application.ScreenUpdating = True Application.CutCopyMode = False End If Set HojaDestino = Nothing Set HojaOrigen = Nothing End Sub
La macro es muy sencilla, empleando las diferentes instrucciones seleccionamos distintas celdas de la Hoja1, y se van copiando en la Hoja2 en las celdas elegidas por nosotros.
Es importante observad las propiedades de cada orden dada, y cómo unas de ellas realizan copiados exactos (incluyendo formatos, fórmulas, etc) y otras sólo son copiados de los valores elegidos. Dependerá de nuestros requerimientos que usemos unas u otras. En nuestro caso, tras ejecutar la macro, obtenemos el siguiente resultado en la Hoja2:
