اذهب الي المحتوي
أوفيسنا

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


Mory Ali

الردود الموصى بها

السلام عليكم

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

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

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

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

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

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

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

TEST.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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

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

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

 

رابط هذا التعليق
شارك

6 minutes ago, ali mohamed ali said:

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

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

 

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

Mory Ali

 

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

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

30 minutes ago, Mory Ali said:

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

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

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

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

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

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

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

هي نطاق نتيجة ما ينتجه الماكرو  ("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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information