Actualizar dos macros creando un combobox
La pregunta va destinada al experto Dante Amor
Necesitaría buscar valores con coincidencia exacta a partir de un cuadro combinado cuyos valores de lista serán cada una de las columnas de la hoja "TITULOS" y el número de fila. El proceso sería seleccionar el nombre de columna en el combo y escribir el valor a buscar en el textbox que se buscaría al seleccionar el botón "Buscar". El valor solo buscaría en la columna de la hoja "Titulos" seleccionada en el combo claro o por número de fila.
Lista de valores del combo por los que buscar:
Fila, Codigo, Titulo, Autor, Editorial, Año (año sería numérico por lo de las comillas)
Los resultados aparecerían en el listbox pero con todos los datos correspondientes a la fila que contiene ese valor como Nº de fila, codigo, titulo, autor, editorial y año
Sería pues crear un combo y actualizar las dos macros que me has propuesto en las preguntas
"Modificar formulario al crear columna codigo" y "Buscar datos y modificarlos abriendo useform ..."
1 Respuesta
H o l a :
Este sería el código para buscar por encabezado:
Private Sub CommandButton1_Click()
'Por.Dante Amor
titulo = UCase(TextBox1)
If titulo = "" Then
MsgBox "Introduce una palabra para buscar", vbExclamation, "BUSCAR"
TextBox1.SetFocus
Exit Sub
End If
'
If IsNumeric(titulo) Then titulo = Val(titulo)
j = 2
col = ComboBox1.ListIndex + 1
Set h1 = Sheets("titulos")
Set r = h1.Columns(col)
Set b = r.Find(titulo, lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
'detalle
htit = UCase(h1.Cells(b.Row, col))
If htit Like titulo Or _
htit Like "* " & titulo Or _
htit Like titulo & " *" Or _
htit Like "* " & titulo & " *" Then
ListBox1. AddItem h1. Cells(b.Row, "A")
ListBox1. List(ListBox1.ListCount - 1, 1) = h1. Cells(b.Row, "B")
ListBox1. List(ListBox1.ListCount - 1, 2) = h1. Cells(b.Row, "C")
ListBox1. List(ListBox1.ListCount - 1, 3) = h1. Cells(b.Row, "D")
ListBox1. List(ListBox1.ListCount - 1, 4) = h1. Cells(b.Row, "E")
ListBox1. List(ListBox1.ListCount - 1, 5) = h1. Cells(b.Row, "F")
ListBox1. List(ListBox1.ListCount - 1, 6) = h1. Cells(b.Row, "G")
ListBox1. List(ListBox1.ListCount - 1, 7) = h1. Cells(b.Row, "H")
ListBox1. List(ListBox1.ListCount - 1, 8) = h1. Cells(b.Row, "I")
j = j + 1
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
Set h1 = Sheets("TITULOS")
For i = 1 To h1.Cells(1, Columns.Count).End(xlToLeft).Column
ComboBox1.AddItem h1.Cells(1, i)
cad = cad & h1.Cells(1, i).Width + 1 & ";"
Next
ComboBox1.SetFocus
ListBox1.ColumnWidths = cad
End Sub'
Hola
Funciona todo muy bien. Lo único que falta como te comenté, es que aparezca en el listbox como primera columna de éste, los números de filas de la hoja "TITULOS" donde se hallan los valores buscados. Solo falta eso.
En cuanto a lo del doble click sobre el listbox te lo mando como me decías en otra pregunta que voy a crear.
Gracias por todo
Te anexo la macro actualizada
Private Sub CommandButton1_Click()
'Por.Dante Amor
titulo = UCase(TextBox1)
If titulo = "" Then
MsgBox "Introduce una palabra para buscar", vbExclamation, "BUSCAR"
TextBox1.SetFocus
Exit Sub
End If
'
If IsNumeric(titulo) Then titulo = Val(titulo)
j = 2
col = ComboBox1.ListIndex + 1
Set h1 = Sheets("titulos")
Set r = h1.Columns(col)
Set b = r.Find(titulo, lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
'detalle
htit = UCase(h1.Cells(b.Row, col))
If htit Like titulo Or _
htit Like "* " & titulo Or _
htit Like titulo & " *" Or _
htit Like "* " & titulo & " *" Then
ListBox1.AddItem b.Row
ListBox1. List(ListBox1.ListCount - 1, 1) = h1. Cells(b.Row, "A")
ListBox1. List(ListBox1.ListCount - 1, 2) = h1. Cells(b.Row, "B")
ListBox1. List(ListBox1.ListCount - 1, 3) = h1. Cells(b.Row, "C")
ListBox1. List(ListBox1.ListCount - 1, 4) = h1. Cells(b.Row, "D")
ListBox1. List(ListBox1.ListCount - 1, 5) = h1. Cells(b.Row, "E")
ListBox1. List(ListBox1.ListCount - 1, 6) = h1. Cells(b.Row, "F")
ListBox1. List(ListBox1.ListCount - 1, 7) = h1. Cells(b.Row, "G")
ListBox1. List(ListBox1.ListCount - 1, 8) = h1. Cells(b.Row, "H")
ListBox1. List(ListBox1.ListCount - 1, 9) = h1. Cells(b.Row, "I")
j = j + 1
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End SubCon la función Additem, solamente se acepta 10 columnas. Ya no se pueden poner más columnas. Si vas a poner más columnas hay que cambiar el código.
'
Hola Dante Amor
¡Vaya! Pues la verdad es que no te querría molestar más de lo necesario pero ahora mismo tengo ya 9 columnas y seguramente tendré que poner más así que si puedes cambiarme el código para que acepte más de 10 columnas... te lo agradecería.
Un saludo y ahora te mando las otras preguntas por email y en privado aquí también.
Así es, recuerda valorar la respuesta y crea las nuevas. S a l u d o s
