ماكرو لعمل تنسيق شرطي

[ابو العرايس]

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

اخواني الاعزار عندي سجل علامات (300 سجل معبأه وجاهزة)لطلاب صف معين عملت ماكرو لعمل تنسيق شرطي للعلامات التي اقل من خمسين بكبسة زر، حيث أقوم باختيار العمود الذي أريده وأضغط (Ctrl + l) فيقوم بعمل التنسيق الشرطي.

المشكلة أنه عندي : ما أريده ان الماكرو يقوم لوحده بمعرفة العمود بناءً على اسمه ويقوم بعمل هذا التنسيق الشرطي، علما بأنه في نفس الصفحة موجود اكثر من عمود بنفس الاسم

مرفق مثال

سبحان الله وبحمده سبحان الله العظيم

FailFormat.rar

تم تعديل نوفمبر 27, 2010 بواسطه TareQ M

[طارق محمود]

السلام عليكم

إستبدل الماكرو بالتالي

Sub FailForman()

'

' FailForman Macro

'

' Keyboard Shortcut: Ctrl+Shift+I

'Select columns titeled المعدل


t = ActiveSheet.Cells.SpecialCells(xlLastCell).Column


For x = 1 To t

	If myR = "" Then fasel = "" Else fasel = ","

	If Cells(1, x) = "المعدل" Then

    	myR = myR & fasel & Cells(2, x).Address & ":" & Cells(20, x).Address

	End If

Next x


Range(myR).Select



	Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _

    	Formula1:="=50"

	Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

	With Selection.FormatConditions(1).Font

    	.Bold = True

    	.Italic = False

    	.Underline = xlUnderlineStyleSingle

    	.Color = -16776961

    	.TintAndShade = 0

	End With

	Selection.FormatConditions(1).StopIfTrue = False


End Sub

مع استبدال الرقم 20 في السطر

myR = myR & fasel & Cells(2, x).Address & ":" & Cells(20, x).Address

بأي عدد من الأسطر مثلا 300

[يحيى حسين]

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

اخي ابو العرايس 

اضافة لحل الاخ طارق 

يمكنك استخدام كود اخر مختلف 

جرب هذا الكود 

 


Sub Conditional()

Dim c As Range, cl As Range, LR As Integer

LR = Range("a" & Rows.Count).End(xlUp).Row

For Each c In Range("A1:x1")

    If c.Value = "المعدل" Then

        For Each cl In Range(Cells(2, c.Column), Cells(LR, c.Column))

            If cl.Value < 50 Then

                 With cl.Font

                    .Underline = xlUnderlineStyleSingle

                    .ColorIndex = 6

                    .Bold = True

                 End With

            End If

        Next cl

    End If

Next c

End Sub

 

دمتم في حفظ الله 

[ابو العرايس]

والله انا أشكركم من أعماق قلبي وجازاكم الله كل الخير عني

سبحان الله وبحمده سبحان الله العظيم

تم تعديل نوفمبر 27, 2010 بواسطه TareQ M

[ابو العرايس]

اخواني الاعزاء لقد قمت بتنفيذ الكودين ، ولكن الكود الاول يعطي خطأ عند Range(myR).Select، وماذا تعني هذه العبارة xlLastCell

والكود الثاني لا يفعل شيء

ياريت يا اخواني يتم تنفيذها على المثال المرفق

وجازاكم الله كل الخير

سحبان الله وبحمده سبحان الله العظيم

[ابو العرايس]

للرقع