Convertir letras con acento a letras sin acento VBA Excel
Desarrollando un buscador de datos me encontré con un problema, muchos de mis datos tienen acentos, y quisiera saber si hay alguna posibilidad de convertir mientras escribo las letras con acento a letras sin ellos.
Actualmente tengo el siguiente código con el cual convierto tanto lo ingresado en el Textbox como el valor de la celda a mayúsculas además que busco fragmentos de texto.
Private Sub TxtBuscar_Change()
Me.EtiquetaInforme2.Caption = ""
If Me.TxtBuscar.Value = "" Then
Me.ListaResultados.Clear
Me.EtiquetaInforme.Caption = "COINCIDENCIAS ENCONTRADAS: 0"
Exit Sub
End If
Dim ResultadosEncontrados As Long
UltimaFila = Application.WorksheetFunction.CountA(Range("A:A"))
If ResultadosEncontrados = 0 Then
Me.ListaResultados.Clear
End If
For i = 1 To UltimaFila
If UCase(Cells(i, 2)) Like "*" & UCase(Me.TxtBuscar.Value) & "*" Or UCase(Cells(i, 3)) Like "*" & UCase(Me.TxtBuscar.Value) & "*" Or UCase(Cells(i, 4)) Like "*" & UCase(Me.TxtBuscar.Value) & "*" Then
ResultadosEncontrados = ResultadosEncontrados + 1
Me.ListaResultados.AddItem Cells(i, 1)
Me.ListaResultados.List(Me.ListaResultados.ListCount - 1, 1) = Cells(i, 5) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4)
End If
Next i
Me.EtiquetaInforme.Caption = "COINCIDENCIAS ENCONTRADAS: " & ResultadosEncontrados
End Sub
1 respuesta
Respuesta de Dante Amor
1
Así quedaría tu macro
Private Sub TxtBuscar_Change()
'Act.Por.Dante Amor
Me.EtiquetaInforme2.Caption = ""
If Me.TxtBuscar.Value = "" Then
Me.ListaResultados.Clear
Me.EtiquetaInforme.Caption = "COINCIDENCIAS ENCONTRADAS: 0"
Exit Sub
End If
Dim ResultadosEncontrados As Long
UltimaFila = Application.WorksheetFunction.CountA(Range("A:A"))
If ResultadosEncontrados = 0 Then
Me.ListaResultados.Clear
End If
'
For i = 1 To UltimaFila
celda2 = UCase(SinAcentos(Cells(i, 2)))
celda3 = UCase(SinAcentos(Cells(i, 3)))
celda4 = UCase(SinAcentos(Cells(i, 4)))
txtbus = UCase(SinAcentos(TxtBuscar))
'
If celda2 Like "*" & txtbus & "*" Or _
celda3 Like "*" & txtbus & "*" Or _
celda4 Like "*" & txtbus & "*" _
Then
ResultadosEncontrados = ResultadosEncontrados + 1
Me.ListaResultados.AddItem Cells(i, 1)
Me.ListaResultados.List(Me.ListaResultados.ListCount - 1, 1) = Cells(i, 5) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4)
End If
Next i
Me.EtiquetaInforme.Caption = "COINCIDENCIAS ENCONTRADAS: " & ResultadosEncontrados
End SubAgrega la siguiente función en tu formulario para reemplazar las letras con acento a letras sin acento.
Function SinAcentos(pal) 'Por.Dante Amor nvo = Replace(pal, "á", "a") nvo = Replace(nvo, "é", "e") nvo = Replace(nvo, "í", "i") nvo = Replace(nvo, "ó", "o") nvo = Replace(nvo, "ú", "u") nvo = Replace(nvo, "Á", "A") nvo = Replace(nvo, "É", "E") nvo = Replace(nvo, "Í", "I") nvo = Replace(nvo, "Ó", "O") nvo = Replace(nvo, "Ú", "U") sinacen = nvo End Function
Saludos.Dante Amor
No olvides valorar la respuesta.
