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

[samycalls]

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

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

[عبدالله المجرب]

السلام عليكم

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

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

[بن علية حاجي]

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

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

أخوك بن علية

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

تم تعديل مارس 14, 2012 بواسطه hben

[بن علية حاجي]

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

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

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

أخوك بن علية

تم تعديل مارس 14, 2012 بواسطه 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

تم تعديل مارس 14, 2012 بواسطه apt

[samycalls]

جميع الردود من الأخوة والأساتذة الكرام ممتازة وتؤدى الغرض .. خالص شكرى وامتنانى ..

[abassreda]

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

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

تم تعديل مارس 16, 2012 بواسطه abassreda