Macro para buscar Palabra Indiferente de Mayúsculas o Minisculas - Excel
Tengo una Macro que me calcula el Ubigeo(Es un código concatenado cuando combinas Departamento, Provincia y Distrito) o llamado también, emplazamiento.
Tengo un Excel y está formado por dos hojas Emplazamiento y el otro Ubigeo.
En la pestaña Emplazamiento tengo: Los campos Departamento, Provincia, Distrito y Emplazamiento.
En la pestaña Ubigeo tengo: Toda la base. Esta base la tengo todo en mayúsculas.
Cuando calculo el emplazamiento usualmente no genera el código porque la macro solo busca la palabra exacta tal y como esta escrito en la base.
Lo que necesito que mi macro realice la busqueda independiente de si es mayúsculas minúsculas, etc
Public Sub BuscarUbigeo()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("UBIGEO").Visible = True
Set h1 = Sheets("EMPLAZAMIENTO")
Set h2 = Sheets("UBIGEO")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
coddepa = ""
codprov = ""
coddist = ""
UBI = ""
For J = 2 To h2.Range("B" & Rows.Count).End(xlUp).Row
If h2.Cells(J, "B") = h1.Cells(i, "A") Then
coddepa = h2.Cells(J, "A")
For k = 2 To h2.Range("D" & Rows.Count).End(xlUp).Row
If h2.Cells(k, "D") = coddepa And _
h2.Cells(k, "F") = h1.Cells(i, "B") Then
codprov = h2.Cells(k, "E")
For m = 2 To h2.Range("H" & Rows.Count).End(xlUp).Row
If h2.Cells(m, "H") = coddepa And _
h2.Cells(m, "I") = codprov And _
h2.Cells(m, "K") = h1.Cells(i, "C") Then
coddist = h2.Cells(m, "J")
Exit For
End If
Next
Exit For
End If
Next
Exit For
End If
Next
If coddepa = "" Or codprov = "" Or coddist = "" Then
UBI = ""
Else
UBI = Format(coddepa, "00") & Format(codprov, "00") & Format(coddist, "00")
End If
h1.Cells(i, "D") = UBI
Next
Sheets("UBIGEO").Visible = False
End Sub
1 respuesta
H o l a:
Una opción es que al momento de realizar la comparación, compares mayúsculas contra mayúsculas; independientemente de cómo estén almacenados los datos, al momento de comparar utilizas la función UCASE, quedaría así:
Public Sub BuscarUbigeo()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("UBIGEO").Visible = True
Set h1 = Sheets("EMPLAZAMIENTO")
Set h2 = Sheets("UBIGEO")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
coddepa = ""
codprov = ""
coddist = ""
UBI = ""
For J = 2 To h2.Range("B" & Rows.Count).End(xlUp).Row
If UCase(h2.Cells(J, "B")) = UCase(h1.Cells(i, "A")) Then
coddepa = h2.Cells(J, "A")
For k = 2 To h2.Range("D" & Rows.Count).End(xlUp).Row
If UCase(h2.Cells(k, "D")) = UCase(coddepa) And _
UCase(h2.Cells(k, "F")) = UCase(h1.Cells(i, "B")) Then
codprov = h2.Cells(k, "E")
For m = 2 To h2.Range("H" & Rows.Count).End(xlUp).Row
If UCase(h2.Cells(m, "H")) = UCase(coddepa) And _
UCase(h2.Cells(m, "I")) = UCase(codprov) And _
UCase(h2.Cells(m, "K")) = UCase(h1.Cells(i, "C")) Then
coddist = h2.Cells(m, "J")
Exit For
End If
Next
Exit For
End If
Next
Exit For
End If
Next
If coddepa = "" Or codprov = "" Or coddist = "" Then
UBI = ""
Else
UBI = Format(coddepa, "00") & Format(codprov, "00") & Format(coddist, "00")
End If
h1.Cells(i, "D") = UBI
Next
Sheets("UBIGEO").Visible = False
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
