[VBA] Επιδιόρθωση κατεστραμμένου κείμενου σε Excel.

[Ms-Office-Development Team]

Δημιουργός: Τάσος Φιλοξενίδης (έτος 2010)
Περιβάλλον: Excel 2000, 2002, 2003, 2007, 2010

´, ¡, ¢, ¸, ¹, º, ¼, ¾, ¿, À, Á, Â, Ã, Ä, Å, Æ, Ç, È, É, Ê, Ë, Ì, Í, Î, Ï, Ð, Ñ, Ó, Ô, Õ, Ö, ×, Ø, Ù, Ú, Û, Ü, Ý, Þ, ß, à, á, â, ã, ä, å, æ, ç, è, é, ê, ë, ì, í, î, ï, ð, ñ, ò, ó, ô, õ, ö, ÷, ø, ù, ú, û, ü, ý, þ

Πολλοί από μας έχουν συναντήσει τους παραπάνω χαρακτήρες όταν ανοίγουν ένα αρχείο Excel που είναι προϊόν κάποιας αυτοματοποίησης (πχ. Εξαγωγή δεδομένων από κάποιο ουδέτερο πρόγραμμα σε μορφή Excel x ).

Δεν υπήρχε, ούτε υπάρχει ανάλογη εντολή στην εφαρμογή Excel για σας επιτρέψει να επαναφέρετε τους χαρακτήρες αυτούς στην κανονική τους μορφή.

Τη λύση λοιπόν στο πρόβλημα αναλαμβάνει η VBA με τη χρήση του παρακάτω κώδικα:

Sub FixBrokenText()
    Dim arr1 As Variant, arr2 As Variant, i As Integer, rng As Range
    Application.ScreenUpdating = False
    Set rng = ActiveSheet.UsedRange
    arr1 = Array(180, 161, 162)
    arr2 = Array(900, 901, 902)
    With rng

        For i = 184 To 254
            .Replace What:=ChrW(i), Replacement:=ChrW(i + 720), LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=True
        Next
        For i = 0 To UBound(arr1)
            .Replace What:=ChrW(arr1(i)), Replacement:=ChrW(arr2(i)), LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=True
        Next
    End With

End Sub