[VBA] Αντικατασταση Γραμματων

[manolis]

Καλημέρα σε όλη την παρέα

Εχω φτιάξει την παρακάτω μακρο για να αντικαταστήσω ελληνικούς χαρακτήρες με αγγλικούς.

Sub ReplaceLetters i()

Columns("H:H").Select
Cells.Replace What:="Α", Replacement:="A"
Cells.Replace What:="Β", Replacement:="B"
Cells.Replace What:="Ε", Replacement:="E"
............................
End sub

Tο προβλημα μου είναι οτι ενω θέλω να γίνει η αλλαγή στη στήλη που επιλέγω , αυτο γίνεται σε όλες τις στήλες.

Τι έχω κάνει λάθος ?

Επίσης θα ήθελα αν γίνεται οτι αλλαγες γίνουν στα γράμματα να επισημανθούν πχ να γίνουν κόκκινα τα γράμματα που θα αλλαχθούν

Ευχαριστώ


ευχαριστώ

[kapetang]

Καλημέρα

Μανώλη, προτείνω να δοκιμάσεις τον παρακάτω κώδικα:

Option Explicit

Sub ReplaceGreekChars()
    Dim rng As Range, c As Range, i As Long
    Dim x As String, y As String

    Set rng = Range("H:H")

    For Each c In rng
        If Len(c) > 0 Then
            x = c: y = x
            y = Replace(Replace(Replace(y, "Α", "A"), "Β", "B"), "Ε", "E")
            If x <> y Then
                c = y
                For i = 1 To Len(x)
                    If Mid(x, i, 1) <> Mid(y, i, 1) Then
                        c.Characters(Start:=i, Length:=1).Font.Color = -16777024
                    End If
                Next
            End If
        End If
    Next
End Sub

Φιλικά/Γιώργος

[kapetang]

Και μια παραλλαγή του κώδικα, που βελτιώνει την ταχύτητα:

Option Explicit

Sub ReplaceGreekChars()
    Dim rng As Range, c As Range, i As Long
    Dim x As String, y As String

    Set rng = Range("H1:H" & Cells(Cells.Rows.Count, 8).End(xlUp).Row)
    Application.ScreenUpdating = False
    For Each c In rng
        If Len(c) > 0 Then
            x = c: y = x
            y = Replace(Replace(Replace(y, "Α", "A"), "Β", "B"), "Ε", "E")
            If x <> y Then
                c = y
                For i = 1 To Len(x)
                    If Mid(x, i, 1) <> Mid(y, i, 1) Then
                        c.Characters(Start:=i, Length:=1).Font.Color = -16777024
                    End If
                Next
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

[manolis]

Καλησπέρα σε όλη την παρέα

Γιώργο σε ευχαριστώ για τις λύσεις που πρότεινες. Τις εφάρμοσα στο αρχείο μου και δουλευουν μια χαρά.

Οσο για το λάθος που έκανα στον δικό μου κώδικα βρήκα τi είναι.
Επρεπε αντι για cells έπρεπε να να βάλω selection

Καλό βράδυ