Búsqueda de palabra con/sin tilde en listbox
Tengo un formulario que tiene un textbox (TXTBuscarNormativa) que me permite buscar información en una tabla.
Necesito que la búsqueda se realice escribiendo una palabra en el textbox "con" o "sin" tilde.
He intentado varias funciones pero no he logrado nada.
Mi programación original es la siguiente:
-------Inicio-------------
Private Sub CMDBuscarNormativa_Click()
Dim xnum As Long, i As Long, j As Long
If TXTBuscarNormativa.Text = "" Then
MsgBox ("Por favor Ingrese el dato a buscar"), vbExclamation, "Error de búsqueda"
TXTBuscarNormativa.SetFocus
Exit Sub
End If
With LSTBuscar
.Clear
xnum = Range("TablaNormativaISAM").CurrentRegion.Rows.Count
For i = 4 To xnum + 2
If LCase(Cells(i, 4).Value) Like "*" & LCase(Me.TXTBuscarNormativa.Text) & "*" Then
.AddItem
.AddItem
For j = 1 To 7
.List(.ListCount - 2, j - 1) = Cells(i, j)
.List(.ListCount - 1, j - 1) = String(120, "-")
Next
End If
Next i
End With
End Sub
--------Fin----------------------
Aunque Excel no es mi especialidad le comento que para hacer las búsquedas con acentos en Access utilizo:
Public Function sin_acento(strCadena As String) As String sin_acento = StrConv(strCadena, 2, 1042) End Function
Preparé esta función en Excel y la llamo en una celda y retorna el texto sin acento. No sé realmente si funcione en la respuesta que usted ha dado.
Nuevamente un cordial saludo.
1 respuesta más de otro experto
Prueba lo siguiente:
Private Sub CMDBuscarNormativa_Click()
Dim xnum As Long, i As Long, j As Long
Dim stxt As String, scel As String
Dim ca As Variant, k As Variant
'
If TXTBuscarNormativa.Text = "" Then
MsgBox ("Por favor Ingrese el dato a buscar"), vbExclamation, "Error de búsqueda"
TXTBuscarNormativa.SetFocus
Exit Sub
End If
ca = Array("á", "a", "é", "e", "í", "i", "ó", "o", "ú", "u")
With LSTBuscar
.Clear
xnum = Range("TablaNormativaISAM").CurrentRegion.Rows.Count
stxt = LCase(Me.TXTBuscarNormativa.Text)
For k = 0 To UBound(ca) Step 2
stxt = Replace(stxt, ca(k), ca(k + 1))
Next
For i = 4 To xnum + 2
scel = LCase(Cells(i, 4).Value)
For k = 0 To UBound(ca) Step 2
scel = Replace(scel, ca(k), ca(k + 1))
Next
If scel Like "*" & stxt & "*" Then
.AddItem
.AddItem
For j = 1 To 7
.List(.ListCount - 2, j - 1) = Cells(i, j)
.List(.ListCount - 1, j - 1) = String(120, "-")
Next
End If
Next i
End With
End SubNOTA: En futuras preguntas, si vas a poner código en el foro, utiliza el icono para insertar código:
¡Muchas Gracias!
Resultó excelente.
Nuevamente excelente la respuesta.
Anotada la observación para el ingreso de código. Pido la disculpa, no lo sabía.
Muy agradecido.
Que tengan un excelente día.
Eric
Utilizando la aportación de Eduardo Pérez, quedaría así:
Private Sub CMDBuscarNormativa_Click()
Dim xnum As Long, i As Long, j As Long
Dim stxt As String, scel As String
'
If TXTBuscarNormativa.Text = "" Then
MsgBox ("Por favor Ingrese el dato a buscar"), vbExclamation, "Error de búsqueda"
TXTBuscarNormativa.SetFocus
Exit Sub
End If
With LSTBuscar
.Clear
xnum = Range("TablaNormativaISAM").CurrentRegion.Rows.Count
stxt = LCase(StrConv(Me.TXTBuscarNormativa.Text, 2, 1042))
For i = 4 To xnum + 2
scel = LCase(StrConv(Cells(i, 4).Value, 2, 1042))
If scel Like "*" & stxt & "*" Then
.AddItem
.AddItem
For j = 1 To 7
.List(.ListCount - 2, j - 1) = Cells(i, j)
.List(.ListCount - 1, j - 1) = String(120, "-")
Next
End If
Next i
End With
End Sub