[Excel07] Μετατροπή Ελληνικών χαρακτήρων σε Greeklis ή Αγγλικά.

[agrbita]

Κύριοι καλησπέρα σας,

Προσπαθώ να μετατρέψω τα δεδομένα ενός κελιού στο excel, από "ΜΕΛπογ7125", σε "MELpog7125".
Τα δεδομένα στο κελί (ή και κελιά) είναι πάντα με δέκα (10) χαρακτήρες και έχουν πάντα την ίδια διαμόρφωση (τα 3 πρώτα κεφαλαία, τα 3 επόμενα μικρά και τα 4 τελευταία αριθμός).
Υπάρχει συνάρτηση ή και VBA που μπορεί να δώσει αυτό το αποτέλεσμα;

Ευχαριστώ

[Spirosgr]

Option Explicit
'Στο Array iFind, βάζουμε, ό,τι θέλουμε να αλλάξουμε.
'Στο Array iReplace, βάζουμε, αυτό με το οποίο θέλουμε να το αλλάξουμε.
'Δεκτό: συνδιασμοί χαρακτήρων πχ: Φ με Fi, τρ με TR
'Δεκτό: αριθμοί
'Δεκτό: multi language

'MatchCase:=True (διακρίνει κεφαλαία - πεζά)
'Αν MatchCase:=False (δεν διακρίνει κεφαλαία - πεζά)

'Τα δύο Array πρέπει να έχουν τις αντίστοιχες τιμές για αντικατάσταση πχ:
'Στην 2η θέση του iFind = "Ω"
'Στην 2η θέση του iReplace = "O"
'Σημαίνει αντικαθιστώ Ω με O

'ΣΗΜΕΙΩΣΗ:

'Στην έκφραση: Sh1.Cells(i, 1)
'Όπου Sh1. = Το κωδικό όνομα φύλλου
'Όπου 1 = Η στήλη φύλλου (1=a , 4=d κλπ)
'Αν το Option Explicit υπάρχει ήδη στον VBA editor, το παραβλέπουμε

Sub Multiple_Search_And_Replace()

    Dim iFind As Variant, iReplace As Variant
    Dim x As Long, i As Long, Lrow As Long

    iFind = Array("Σ", "Ω", "Γ", "Δ", "Φ", "Π", "ρ", "σ", "ξ", "ω", "22")

    iReplace = Array("S", "O", "G", "D", "Fi", "P", "r", "s", "ks", "o", "55")

    Lrow = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To Lrow

        For x = LBound(iFind) To UBound(iFind)

            Sh1.Cells(i, 1).Replace What:=iFind(x), Replacement:=iReplace(x), _
                                    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
                                    SearchFormat:=False, ReplaceFormat:=False

        Next x

    Next i

End Sub