اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كيفية تحديد عدد الأرقام فى الخلية باضافة اصفار على الشمال من خلال كود وليس بالتنسيق أو المعادلات


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

السلام عليكم

ضع هذا الكود في حدث ورقة العمل


Private Sub Worksheet_Change(ByVal Target As Range)

Range("B4:E20").NumberFormat = "@"

If Not Intersect(Target, [B4:E20]) Is Nothing Then

    Select Case Target.Column

	    Case 2:

	    If Len(Target) < 2 Then Target = "0" & Target

	    Case 3:

	    If Len(Target) < 3 Then w = 3 - Len(Target)

	    Do Until Len(Target) = 3

			   Target = "0" & Target

		  Loop

	    Case 4:

	    If Len(Target) < 4 Then w = 4 - Len(Target)

	    Do Until Len(Target) = 4

			   Target = "0" & Target

		  Loop

	    Case 5:

	    If Len(Target) < 5 Then w = 5 - Len(Target)

	    Do Until Len(Target) = 5

			   Target = "0" & Target

		  Loop

    End Select

End If

End Sub

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

السلام عليكم ورحمة الله

أخي الكريم، لست أدري لماذا لا تريد أن يكون الحل بالتنسيقات أو بالمعادلات؟ رغم أن الحل بالتنسيقات أحسن وأفضل (ربما يقلل من سرعة عمل الملف إذا كانت تنسيقات أخرى مكثفة)... المهم في الملف المرفق تجد حلا بكود يغير تنسيق أرقام خلايا نطاق معين حسب رقم العمود في النطاق... وأعترف أن الإخوة الكرام لا يبخلون بأكواد أخرى تكون أفضل مما قدمته...

أخوك بن علية

صفر على الشمال.rar

تم تعديل بواسطه hben
  • Like 1
رابط هذا التعليق
شارك

السلام عليكم ورحمة الله

أخي الكريم، إضافة إلى الكودين السابقين (كود أخي وحبيبي أبو أحمد والكود الذي قدمته في الملف السابق) يمكن أيضا استعمال الكود التالي في حدث ورقة العمل :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False

If Not Intersect(Target, [B4:E100]) Is Nothing Then

Target.NumberFormat = Application.WorksheetFunction.Rept(0, Target.Column)

End If

Application.ScreenUpdating = True

End Sub

أخوك بن علية

تم تعديل بواسطه hben
رابط هذا التعليق
شارك

السلام عليكم

هذا اختصار لكود الاستاذ بن عليه


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, [B4:E20]) Is Nothing Then

Target.NumberFormat = Application.Rept(0, Target.Column)

End If

End Sub

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

السلام عليكم،

جرب الملف المرفق.

تحرير :

عذرا للاخ عبد الله والاخ بن علية لاني لم ار اجابتهما قبل وضع ردي.

صفر على الشمال (1).rar

تم تعديل بواسطه apt
رابط هذا التعليق
شارك

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

ولكم جزيل الشكر ووافر الأحترام

تم تعديل بواسطه abassreda
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information