Buscar Códigos omitiendo valores cero en formulario de excel
Es una pregunta para Dante Amor
Hola
Cuando en el formulario, selecciono del listado del combo, el encabezado "Código" y busco me resulta incómodo tener que buscar un valor insertando todos los ceros... Por ejemplo si quiero buscar el código R45 tengo que poner R000045 porque es así realmente cómo está insertado, si pongo R45 no lo encuentra.
Mi pregunta es si se podría escribir por ejemplo R45 o R234 etc. Por comodidad y que se convirtiera en R000045 O R000234 para así buscar y que encontrara el registro.
1 Respuesta
H o l a:
Esta es la parte que agregué al código:
'Validar si es la columna código para reemplzar R1 por R000001 If col = 1 Then titulo = Left(titulo, 1) & Format(Mid(titulo, 2), "000000") End If
completo:
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
'Application.ScreenUpdating = False
'Buscar
Set h1 = Sheets("TITULOS")
Set h2 = Sheets("FILTRO")
h2.Cells.Clear
titulo = UCase(TextBox1)
If titulo = "" Then
'MsgBox "Introduce una palabra para buscar", vbExclamation, "BUSCAR"
'TextBox1.SetFocus
'Application.ScreenUpdating = True
'Exit Sub
FiltrarTodo h1, h2
Exit Sub
End If
'
If IsNumeric(titulo) Then titulo = Val(titulo)
j = 2
col = ComboBox1.ListIndex + 1
'
'Validar si es la columna código para reemplzar R1 por R000001
If col = 1 Then
titulo = Left(titulo, 1) & Format(Mid(titulo, 2), "000000")
End If
ucol = h1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
h1.Columns(ucol).ClearContents
If ComboBox1 = "" Then
Set r = h1.Cells
Else
Set r = h1.Columns(col)
End If
Set b = r.Find(titulo, lookat:=xlPart, LookIn:=xlValues)
If Not b Is Nothing Then
ncell = b.Address
h1.Rows(1).Copy h2.Rows(1)
If ComboBox1 = "" Then
col = b.Column
End If
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
If h1.Cells(b.Row, ucol) = "" And b.Row > 2 Then
h1.Rows(b.Row).Copy h2.Rows(j) '.PasteSpecial Paste:=xlValues
h2.Cells(j, ucol) = b.Row
j = j + 1
h1.Cells(b.Row, ucol) = "x"
End If
End If
'
'If h1.Cells(b.Row, ucol) = "" And b.Row > 2 Then
' h1.Rows(b.Row).Copy h2.Rows(j) '.PasteSpecial Paste:=xlValues
' h2.Cells(j, ucol) = b.Row
' j = j + 1
' h1.Cells(b.Row, ucol) = "x"
'End If
'
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
u = h2.Range("A" & Rows.Count).End(xlUp).Row
If u = 1 Then
MsgBox "No se encontraron resultados"
Else
h2.Columns(ucol).Cut
h2.Columns("A:A").Insert Shift:=xlToRight
h2.[A1] = "FILA"
h2.Cells.EntireColumn.AutoFit
'
ucol = h2.Cells(1, Columns.Count).End(xlToLeft).Column
letra = Evaluate("=SUBSTITUTE(ADDRESS(1," & ucol & ",4),""1"","""")")
For i = 1 To ucol
cad = cad & Int(h2.Cells(1, i).Width) + 1 & ";"
Next
ComboBox1.SetFocus
ComboBox2.Enabled = False
ListBox1.ColumnCount = ucol
ListBox1.ColumnWidths = cad
'
ListBox1.RowSource = h2.Name & "!A2:" & letra & u
End If
Else
MsgBox "No se encontraron resultados"
End If
Set h1 = Nothing
Set h2 = Nothing
Set b = Nothing
Set r = Nothing
Application.ScreenUpdating = True
End Subs a l u d o s
¡Gracias!
Realmente lo que quería es que cuando yo escribiera R45 en el textbox se convirtiera en el mismo textbox que he escrito R45 en R000045, vamos que se actualizara al valor real que existe y así cuando pulsara BUSCAR, buscara el código real... pero lo que me indicas funciona perfecto.
Un saludo y gracias de nuevo
