السلام عليكم
استخدم هذا الكود لإزالة الهمزات والمسافات الزائدة واستبدال (ى) بـ (ي) واستبدال (ة) بـ (ه)
Sub ReplaceChar()
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'هذا الكود لإزالة المسافات الزائدة فى الأسماء
Sheets("Teachers Data").Select
Sheets("Teachers Data").[B6:B324].Select
For Each cell In Selection
cell.Value = Application.WorksheetFunction.Trim(cell.Value)
'هذا الكود لاستبدال الحروف
Sheets("Teachers Data").Range("B6:B324").Replace "أ", "ا"
Sheets("Teachers Data").Range("B6:B324").Replace "إ", "ا"
Sheets("Teachers Data").Range("B6:B324").Replace "آ", "ا"
'-----------------
Sheets("Teachers Data").Range("B6:B324").Replace "ة", "ه"
Sheets("Teachers Data").Range("B6:B324").Replace "ى", "ي"
Next
Sheets("Teachers Data").[B5].Select
MsgBox "ـ تم ضبط الاسماء بأستبدال ( أ - إ - آ ) بـ ( ا ) ـ" & _
vbCrLf & "ـ استبدال (ة) بـ (ه) || استبدال (ى) بـ (ي) ـ" & _
vbCrLf & "وإزالة المسافات الزائدة", vbInformation
End Sub
----
وهو يعمل لكنه بطئ ، فهل هناك كود أفضل من ذلك
أو كيف يمكن التعديل عليه ليعمل بصورة أفضل