¿Cómo hacer una búsqueda exacta entre celdas que no coinciden con su ortografía (Excel2016)?

[Gra cias por los buenos deseos, de igual manera te deseo un año con mucha salud y de éxitos.

Te propongo una macro para buscar el nombre.

---

Supongo que los datos de nombre y número están en las columnas A y B.

Puedes poner el código en un tercer libro, pero los libros 1 y 2 deben estar abiertos.

---

Lo que hace la macro, en memoria, es quitar todos los caracteres y espacios y dejar solamente letras, en ambas casos.

Por ejemplo, si en el archivo 1 tienes: "Cañon, SA" y en el archivo 2 tienes "CANÓN S. A."

Lo que hace la macro es convertir ambos nombres en "canonsa", de esa manera los compara y si coinciden, entonces te pone el número.

---

Debes Ajustar los nombres de los libros y de las hojas en la macro:

Pon todo el código en un módulo y ejecuta la macro BuscarNombre.

Sub BuscarNombre()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim dic As Object
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long
  Dim nombre As String
  '
  'Datos del Archivo 1
  Set sh1 = Workbooks("Archivo 1").Sheets("Hoja1")
  a = sh1.Range("A2:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  ReDim c(1 To UBound(a, 1), 1 To 1)
  '
  'Datos del Archivo 2
  Set sh2 = Workbooks("Archivo 2").Sheets("Hoja1")
  b = sh2.Range("A2:B" & sh2.Range("A" & Rows.Count).End(3).Row).Value
  '
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(b, 1)
    nombre = limpiarnombre(a(i, 1))
    dic(nombre) = b(i, 2)
  Next
  '
  For i = 1 To UBound(a, 1)
    nombre = limpiarnombre(a(i, 1))
    If dic.exists(nombre) Then
      c(i, 1) = dic(nombre)
    End If
  Next
  '
  Sh1. Range("B2").Resize(UBound(b, 1), 1).Value = c
End Sub

Si hay algún caracter que no estoy considerando, dame un ejemplo para ponerlo en el código de la macro.

También pon el siguiente código en el mismo módulo:

Lo puse en imagen porque el editor de este foro no me permite poner la instrucción Chr

Te pongo el código, pero debes reemplazar las "xxx" por Chr

Function limpiarnombre(dato As Variant)
  Dim k As Long
  For k = 33 To 64
    dato = Replace(dato, xxx(k), "")
  Next
  For k = 91 To 96
    dato = Replace(dato, xxx(k), "")
  Next
  For k = 123 To 125
    dato = Replace(dato, xxx(k), "")
  Next
  dato = Replace(LCase(Trim(dato)), " ", "")
  dato = Replace(dato, "ñ", "n")
  dato = Replace(dato, "á", "a")
  dato = Replace(dato, "é", "e")
  dato = Replace(dato, "í", "i")
  dato = Replace(dato, "ó", "o")
  dato = Replace(dato, "ú", "u")
  limpiarnombre = dato
End Function

Ya encontré la manera de poner, aquí en el for, la función Chr.

Te pongo el código completo:

Sub BuscarNombre()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim dic As Object
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long
  Dim nombre As String
  '
  'Datos del Archivo 1
  Set sh1 = Workbooks("Archivo 1").Sheets("Hoja1")
  a = sh1.Range("A2:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  ReDim c(1 To UBound(a, 1), 1 To 1)
  '
  'Datos del Archivo 2
  Set sh2 = Workbooks("Archivo 2").Sheets("Hoja1")
  b = sh2.Range("A2:B" & sh2.Range("A" & Rows.Count).End(3).Row).Value
  '
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(b, 1)
    nombre = limpiarnombre(a(i, 1))
    dic(nombre) = b(i, 2)
  Next
  '
  For i = 1 To UBound(a, 1)
    nombre = limpiarnombre(a(i, 1))
    If dic.exists(nombre) Then
      c(i, 1) = dic(nombre)
    End If
  Next
  '
  sh1.Range("B2").Resize(UBound(b, 1), 1).Value = c
End Sub
Function limpiarnombre(dato As Variant)
  Dim k As Long
  For k = 33 To 64
    dato = Replace(dato, Chr (k), "")
  Next
  For k = 91 To 96
    dato = Replace(dato, Chr (k), "")
  Next
  For k = 123 To 125
    dato = Replace(dato, Chr (k), "")
  Next
  dato = Replace(LCase(Trim(dato)), " ", "")
  dato = Replace(dato, "ñ", "n")
  dato = Replace(dato, "á", "a")
  dato = Replace(dato, "é", "e")
  dato = Replace(dato, "í", "i")
  dato = Replace(dato, "ó", "o")
  dato = Replace(dato, "ú", "u")
  limpiarnombre = dato
End Function

¡Gracias! 

Lo checo y le comento como me fue, saludos.

Buenas noches Dante Amor, los caracteres que hacen falta incluir son: el punto, la coma, el espacio y también las vocales acentuadas en mayúsculas puesto que en el primer archivo los nombres están en minúsculas y el segundo todo esta escrito en mayúsculas . Por otro lado, te comento que al ejecutar la macro me marco el siguiente error: 

El punto, la coma, el espacio y también las vocales acentuadas en mayúsculas puesto que en el primer archivo los nombres están en minúsculas y el segundo todo esta escrito en mayúsculas .

Todos están incluidos!

Los caracteres punto y coma están incluidos en estas sentencias:

  For k = 33 To 64
    dato = Replace(dato, Chr (k), "")
  Next
  For k = 91 To 96
    dato = Replace(dato, Chr (k), "")
  Next
  For k = 123 To 125
    dato = Replace(dato, Chr (k), "")
  Next

El espacio y convertir a minúsculas está incluido en esta línea:

Dato = Replace(LCase(Trim(dato)), " ", "")

Y todas las letras acentuadas están aquí:

  dato = Replace(dato, "á", "a")
  dato = Replace(dato, "é", "e")
  dato = Replace(dato, "í", "i")
  dato = Replace(dato, "ó", "o")
  dato = Replace(dato, "ú", "u")

---

Te muestro la tabla ascii de caracteres:

Todos los caracteres marcados en amarillo están considerados en la macro.

Me refiero, a que si después de ejecutar la macro, tienes algún nombre que no encontró su número. Entonces puede deberse a un caracter que no estoy considerando. Pero necesito que me digas el ejemplo.

---

En cuanto al error, es un problema en tus datos o de tu hoja o de tu segundo libro.

Si te das cuenta estas dos líneas son similares:

  a = sh1.Range("A2:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  b = sh2.Range("A2:B" & sh2.Range("A" & Rows.Count).End(3).Row).Value

Pero te marcó error en la línea del segundo libro.

Revisa qué diferencia tienes entre la hoja del primer libro y la hoja del segundo libro.

---

Si gustas, puedo revisar tus archivos. Envíamelos a mi correo.

[email protected]