Εμφάνιση ενός μόνο μηνύματος
  #3  
Παλιά 05-06-15, 14:49
kapetang Ο χρήστης kapetang δεν είναι συνδεδεμένος
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

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

Κώδικας:
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
Απάντηση με παράθεση