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

1 Respuesta

3.687.375 pts. Si me amas, siempre voy a estar en tu corazón; si me...

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
' : )

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas