
05-06-15, 14:49
|
Όνομα: Γιώργος Έκδοση λογισμικού 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
|