حذف نقطة من خلية بها رقم دون تاثير على تنسيق

[Mory Ali]

السلام عليكم

لدي ملف به عمود يحتوى على ارقام او ارقام و حروف بتنسيق نص 

بعض الخلايا داخل العمود بها نقط بالاضافة الي الارقام او الحروف 

المطلوب : حذف النقط اذا كانت في اول المكتوب او اخره اما اذا كانت في متوسط المكتوب فلا تحذف 

علما بان لا يوجد حجم او عدد ثابت للمكتوب داخل الخلية 

ايضا يرجي العلم اني حاولت حذف المكتوب من خلال Ctrl + F 

و من ثم اختيار استبدال و لكن للاسف عند العمل على هذا تم تغير التنسيق مرة اخري و عند محالوة العمل على اعادة التنسيق مرة اخري فلم ينجح الامر 

مرفق لكم ملف به مثال 

TEST.xlsx

[shreif mohamed]

يمكنك وضع المعادلة التالية في الخلية

b1

ثم السحب لاسفل

=IF(ISBLANK($A1),"",IF((RIGHT($A1,1)="."),REPLACE($A1,LEN($A1),1,""),IF((LEFT($A1,1)="."),REPLACE($A1,1,1,""),$A1)))

 

[سليم حاصبيا]

جرب هذا الملف

 

TEST Salim.xlsx

[سليم حاصبيا]

يمكن ايضاً استعمال الماكرو لهذا الغرض

الماكرو

Option Explicit

Sub remove_chr()
If ActiveSheet.Name <> "salim" Then Exit Sub
Range("d:d").ClearContents
Dim Arr, k%, i%, m%
k = Cells(Rows.Count, 1).End(3).Row
  For m = 1 To k
    Arr = Split(Range("A" & m), Chr(46))
        For i = LBound(Arr) To UBound(Arr)
            If Arr(i) <> "" Then _
            Arr(i) = Arr(i) & Chr(46)
        Next
    Arr = Join(Arr, "")
     If Arr <> "" Then _
     Range("A" & m).Offset(0, 3) = Mid(Arr, 1, Len(Arr) - 1)
  Next
End Sub

الملف مرفق

 

TEST Salim.xlsm

[Mory Ali]

شكرا للاجابة و المساعدة 

هل يمكني السؤال اذا كان حجم الملف يحتوي على اكثر من 400 الف سجل لعمل المطلوب سابقا 

فهل التنفيذ من خلال ماكرو او من خلال معادلة 

ايهما سيكون اسرع ؟

[Ali Mohamed Ali]

السلام عليكم أخى شريف

معادلة حضرتك لا تقوم بحذف النقطة اذا كانت فى أول  الرقم أو المكتوب من جهة اليسار -من فضلك هل يمكن تعديلها حتى تكتمل وتعم الفائدة

 

[shreif mohamed]

6 minutes ago, ali mohamed ali said:

السلام عليكم أخى شريف

معادلة حضرتك لا تقوم بحذف النقطة اذا كانت فى أول  الرقم أو المكتوب من جهة اليسار -من فضلك هل يمكن تعديلها حتى تكتمل وتعم الفائدة

 

المعادلة تعمل معي وبكفائة حسب ماهو مطلوب وماوضحه الاخ 

Mory Ali

 

في طلبه وهو ان تواجدت  نقطة في اخر او اول الرقم يتم حذف النقطة اما ان تواجدت في المنتصف تترك كما هي

ومرفق لك المعادلة داخل ملف العمل

30 minutes ago, Mory Ali said:

شكرا للاجابة و المساعدة 

هل يمكني السؤال اذا كان حجم الملف يحتوي على اكثر من 400 الف سجل لعمل المطلوب سابقا 

فهل التنفيذ من خلال ماكرو او من خلال معادلة 

ايهما سيكون اسرع ؟

بعد اذن الاخ سليم يفضل العمل من خلال الماكرو   لمثل هذا العدد من الصفوف

لذا انصحك باستخدام الماكرو

TEST Salim.xlsx

[Ali Mohamed Ali]

من فضلك أخى الكريم لاحظ هذه الصورة من الملف الذى قمت بإرساله

 

[shreif mohamed]

النقطة تتواجد في منطقة واحدة اما في اول الرقم او اخره او اي مكان اخر

وهذا كان المطلوب من الاخ صاحب الموضوع

وما ارفقته يوجد به نقتطان   لذا ان تعمل المعادلة

ولمعالجة النقتطان يمكنك استخدام الماكرو المرفق من الاخ سليم

وشكرا

[Mory Ali]

هل من شرح للماكرو نظرا لعدم المامي التام بتفصيل انشاء ماكرو 

Option Explicit

Sub remove_chr()
If ActiveSheet.Name <> "salim" Then Exit Sub
Range("d:d").ClearContents
Dim Arr, k%, i%, m%
k = Cells(Rows.Count, 1).End(3).Row
  For m = 1 To k
    Arr = Split(Range("A" & m), Chr(46))
        For i = LBound(Arr) To UBound(Arr)
            If Arr(i) <> "" Then _
            Arr(i) = Arr(i) & Chr(46)
        Next
    Arr = Join(Arr, "")
     If Arr <> "" Then _
     Range("A" & m).Offset(0, 3) = Mid(Arr, 1, Len(Arr) - 1)
  Next
End Sub

هي نطاق نتيجة ما ينتجه الماكرو  ("d:d")هي اسم ورقة العمل  و  salim  من المفهوم 

فهل من شرح لباقي الرموز حتي يتاح لي تغير الرموز كي تتماشي مع رموز و نطاقات ورقة العمل لدي

يعني 

K , m ,i

ماذا تعني ؟

End(3)او  Chr(46)و ايضا ماذا يعني 

 اذا امكن التوضيح من الاخ الفاضل  سليم حاصبيا  اكون شاكرا 

shreif mohamed اما بالنسبة الي معادلة  الاخ   فهي تعمل و بكفاءة و لكنها مع حجم ملف ينهنج نظرا لحجم حقول كما ذكر و بالفعل المطلوب هو حذف نقطة واحدة   يمينا  او يسارا

حقل به نقطة يمينا و يسارا فعليك استخدام المعادلة مرتين مرة على الحقل الاساسي و مرة اخري على ناتج اول معادلة او استخدم معادلة الاخ  ali mohamed aliو اذا  كان لدي الاخ سليم حاصبيا

عذرا للاطالة و في انتظار معلومة شرح طريقة انشاء و تنفيذ ماكرو و ما يستتبعه من تفاصيل الرموز الموجودة في ماكرو 

 

[سليم حاصبيا]

بالاضافة الى ما ورد بالمشاركة السابقة يمكن استبدال الماكرو بهذا (اسرع لانه يحتوي على حلقة تكرارية واحدة)

Option Explicit
Sub Take_Without_Dot()
Dim x%, y%, m%, s$, LrB%, LrA%

LrA = Cells(Rows.Count, 1).End(3).Row
LrB = Cells(Rows.Count, 2).End(3).Row
Range("B1:B" & LrB).ClearContents
 
For m = 1 To LrA
     s = Range("a" & m)
     x = InStr(s, ".")
   If x = 1 Then s = Mid(s, 2, Len(s))
     y = InStr(Len(s), s, ".")
   If y Then s = Mid(s, 1, Len(s) - 1)
    Range("B" & m) = s
Next
End Sub

او استعمال دالة معرفة موجودة في الملف المرفق

 

 ماكرو للدالة

Option Explicit
Function Elim_Chr(Rg As Range, Optional Dot As String)
Dim s, x%, y%
If IsMissing(Dot) Then Dot = ""
  s = Rg
  x = InStr(s, Dot)
  If x = 1 Then s = Mid(s, 2, Len(s))
  y = InStr(Len(s), s, Dot)
  If y Then s = Mid(s, 1, Len(s) - 1)
   If s = 0 Then s = ""
  Elim_Chr = s
End Function

 

 

CChr with function.xlsm