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

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

السلام عليكم بعد اذن الاستاذ بن عليه جرب المرفق تقسيم.rar

بارك الله فيك استاذ طارق على هذا الجهد المميز

للتقريب استخدم هذه =ROUND(C4*10%;1)*10

السلام عليكم اثراء للموضوع هذه دالة لاقتطاع الرقم الصحيح =TRUNC(A1)

السلام عليكم اخواني الكرام هذا حل للسؤال الخاص بدالة تقريب الدالة بها طريقتين للتقريب الاولى اذا كان بعد الفاصلة رقم واحد مثل 1.6 او 1.9 او 1.3 سيتم التقريب الى التالي 1. اذا كان اقل من 5 سيصبح الرقم بدون تقريب مثل 1.3 سيصبح 1 99.4 ستصبح 99 2. اذا كان يساوي 5 لن يتم الاتقريب 3. اذا اكثر من 5 ستم زيادة 1 مثل 6.6 ستصبح 7 ========== الحالة الثانية وهي اذا كان الرقم بعد الفاصلة من رقمين سيتم التقريب بنفس الحالة الاولى لكن الى الرقم الاول بعد الفاصلة هذا هو كود الدالة Function RoudFun(MyCel As String) If MyCel = Empty Then RoudFun = "": Exit Function MyCel_Int = Int(MyCel) MyCel2 = Round(MyCel - MyCel_Int, 3) If Len(MyCel2) = 1 Then RoudFun = MyCel: Exit Function If Len(MyCel2) = 3 Then Select Case MyCel2 Case 0 To 0.4: RoudFun = MyCel_Int Case 0.5 To 0.5: RoudFun = MyCel_Int + 0.5 Case 0.6 To 0.9: RoudFun = MyCel_Int + 1 End Select End If If Len(MyCel2) = 4 Then Select Case Val(Mid(MyCel2, 4, 1)) Case 0 To 4: RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3)) Case Is = 5: RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3)) + "0.0" & Val(Mid(MyCel2, 4, 1)) Case 6 To 9: RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3)) + "0.1" End Select End If End Function وهذا هو المرفق RoudFun.rar

ان شاء الله ساقوم في الغد بحل السؤال ان لم يجد من يجي عليه

اليك هذا الربط http://www.officena.net/ib/index.php?showtopic=33810

تم تعديل العنوان للدلالة

هناك عدة طرق للاستفادة مثل لو اردت استخراج جميع كتب المؤالف لو اردت عمل احصائيات والكثير الكثير

استاذ احمد زمان ابو ابراهيم اشكر لك تواضعك وهذا اقل من بعض ما عندكم

السلام عليكم وبعد اذن الاستاذ احمد هذه محاولة على قد الحال Public Sub Abu_Ahmed() MySh = ActiveSheet.Name If Mid(MySh, 1, 8) <> "إجماليات" Then Exit Sub r = Mid(MySh, 9, Len(MySh) - 8) ActiveSheet.Copy Before:=Sheets(MySh) ActiveSheet.Name = r ActiveSheet.DrawingObjects.Delete End Sub شاهد المرفق ترحيل (4).rar

لا عليك اخي جودة كل الشكر للبشمهندس طارق

جرب هذه المعادلة =COUNTIFS($B$2:$B2;$B2;$D$2:$D2;$D2)>1

السلام عليكم تم اغلاق الموضوع تمهيداً لحذفه لمخالفة قواعد المشاركة حيث لديك موضوع سابق على هذا الرابط http://www.officena.net/ib/index.php?showtopic=40690

السلام عليكم استاذي القدير ابوعلي لي طلب شرحين في الكود اتمنى ان اجد الاجابة الوافية لديك (كما عودتنا) الشرح هنا ليس يخص دوره في الكود وانما شرح لدور الدوال الموجودة فيه الطلب الاول شرح لهذا الجزء If Not InStr(kh_pic, ":") Then MyPath = ThisWorkbook.Path MyFile = MyPath & "\" & kh_pic & "\" & CStr(MyRng) === الطلب الثاني If Not Dir(MyFile & Trim(Tp), vbDirectory) = vbNullString Then MyShap.Fill.UserPicture MyFile & Trim(Tp) ibo = True وشكراً

السلام عليكم اخي الكريم تابع هذا الرابط http://www.officena.net/ib/index.php?showtopic=39323

اخي محمد ضع مرفق للعمل عليه

السلام عليكم اخي الفاضل ضع مرفق وبين فيه ما تريد

بارك الله فيك اخي الشهابي كنت ابحث عنه فقد مر علي

السلام عليكم هذا الرابط قد يجيب على سؤالك http://www.officena.net/ib/index.php?showtopic=39071

السلام عليكم تفضل الماكرو بعد التعديل عليه tafkeet.rar

السلام عليكم اخواني الكرام الى حين ان يتم رفع دروس جديدة اليكم هذا السوال == قم بعمل دالة تقريب تقرب الكسر حسب هذه الشروط 1. من 0.01 الى 0.05 يتم التقريب الى 0.05 2. من 0.06 الى 0.09 يتم التقريب الى 0.1 مثالين 1.53 ======== 1.55 1.39 =====1.4

اخي الفاضل السبب في الفاصلة الغير منقوطة =ROUND(A1*2;1)/2

على عجالة لانها دقت ساعة اغلاق الكمبيوتر في حدث الصفحة ضع هذا الكود Private Sub Worksheet_Calculate() [G10] = [G10] + [E6] End Sub