هل يوجد معادلة وليس كود لاضافة دوائر عند تحقق الشرط في اوفيس 2003 معادلة الدوائر.rar

السلام عليكم اخي الحبيب رجب ........حفظه الله يمكنك انتقاء الاعمدة التي تريدها باستخدام الدالة Choose بدلا من استخدام الشروط ' هنا تحدد الاعمدة المطلوبة c = Choose(cc, 8, 9, 12, 13, 16, 17, 20, 21, 25, 27) الكود كاملا Sub KH_Dwayr() Dim X As Integer, i As Integer, c As Integer, cc As Integer Dim myshp As Shape '=========================== Del X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For i = 11 To Cells(Rows.Count, "B").End(xlUp).Row Step 4 For cc = 1 To 10 ' هنا تحدد الاعمدة المطلوبة c = Choose(cc, 8, 9, 12, 13, 16, 17, 20, 21, 25, 27) With Cells(i, c) If Not IsEmpty(.Value) And Val(.Value) < 0.5 * Val(Cells(10, c)) Or .Value = "غ" Then Set myshp = ActiveSheet.Shapes.AddShape(msoShapeOval, .Left + 2, .Top + 1, .Width - 2, 4 * .Height - 2) With myshp .Fill.Visible = msoFalse .Line.Weight = 2 .Line.ForeColor.SchemeColor = 10 .Line.Visible = msoTrue .Shadow.Visible = msoFalse End With End If End With Next Next ActiveWindow.Zoom = X Application.ScreenUpdating = True End Sub شاهد المرفق 2003 دوائر.rar