الـعيدروس

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

طيب مارأيك بإرفاق الملف وسوف أقوم بعمل ملف ريجستري وضغطه مع ملفك عندما يفتح الملف يتفعل الماكرو اتوماتك دون اللجوء الى اعدادات الماكرو حقوق المعلومه للأستاذ محمد يحياوي حفظه الله ورعاه اذا تحب او ابحث بمحرك البحث لدى المنتدى وسوف تلقى الموضوع نفسه كي تتعلم الحركه تقبل تحياتي

السلام عليكم الاخ الفاضل بإرفاقك للملف بالكامل لم يفيد بالعكس توهنا هذا عن نفسي ماتدري من وين تمسك رأس الخيط ولاكن افضل ارفاق مثال بسيط وعليه المعادلة او مرفق وعليه شرح بسيط لمن اراد ان يتجاوب ويعمل اللازم ارجو منك تقبل الرأي تحياتي

السلام عليكم المرفق وعليه الكود الملف من المشاركة التي اشرت عليها جرب وابلغنى بالنتائج والسلام عليكم ALIDROOS_CP.rar

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

انا جربته على اكثر من 20000 صف وعمل بكفائة ارجو منك ارفاق نسخة من الملف اذا كان الملف به اسرار عمل بإمكانك إرساله على ايميلي او اعمل نسخه من الملف وضيف بيانات وهميه وارفقه الله لايهينك كي نعرف مالمشكلة

مامعنى بين خليتين انت طلبت من 0 الى رقم احدده في خليه B1 والمرفق الذي في المشاركة السابقة يأدي هذا الطلب واذا كان غير المطلوب وضح اكثر

حل رائع استاذ عبدالله زادك الله علماً وحلماً

السلام عليكم الاخ الفاضل hamizic تم حل طلبك في الموضوع السابق

جرب هكذا Public Sub ali() Application.ScreenUpdating = False Dim SH As Worksheet For T = 2 To Sheets.Count Set SH = Sheets(T) Q = SH.Cells(Rows.Count, 2).End(xlUp).Row If SH.Range("B" & Q).Value = "الاجمالى" Then GoTo 1 Exit Sub Else SH.Activate Range("B" & Q).Select With SH .Range("A" & Q + 1).Value = TextBox1 .Range("B" & Q + 1).Value = TextBox2 End With End If Sheet1.Activate 1 Next T End Sub

السلام عليكم اعذرني انا غشيم بالمعادلات ورغم ان المعادلة ربما بسيطه ولاكن جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 8 Or Target.Row <> 9 Then Exit Sub If Not Intersect(Target, Range("H9")) Is Nothing Then With Range("A1:E1") Set C = .Find(Target.Value, LookIn:=xlValues) If Not C Is Nothing Then Target.Offset(0, 2).Value = C.Column End If End With End If End Sub حطه في حدث الورقة

السلام عليكم الاستاذ مجدي يونس حفظكم الله عمل مميز سلمت يمناك من ابداع الى ابداع تقبل مروري

السلام عليكم حط هذا الكود في حدث الورقة المراد عمل عليه الشرط المطلوب Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Or Target.Row > 1 Then Exit Sub If Not Intersect(Target, Range("A1")) Is Nothing Then If Target.Value > Target.Offset(0, 1).Value Then MsgBox "الرقم المدخل أكبر من الرقم الإفتراضي", vbCritical, "تحذير !!!" Target.Value = Empty Target.Offset(0, 1).Select Else Exit Sub End If End If End Sub حصر قيمة.rar

شوف هذا تسجيل ماكرو شغل الماكرو ورح جرب اكتب رقم اكبر من العشره في خلية A1 وشوف وش راح يظهر لك Sub Macro1() Range("A1").Select With Selection.Validation .Delete .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="0", Formula2:="10" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "تنبية !!! " .InputMessage = "" .ErrorMessage = "الرقم أكبر من الرقم الإفتراضي" .ShowInput = True .ShowError = True End With End Sub

الحصر بمعنى ايه يعني منع ادخال رقم اكبر من المحصور اذا كان كذا ربما تقدر عن طريق التحقق من الصحة

الحمد لله

جزاك الله خير على الشرح وننتظر المزيد منك تقبل تحياتي وشكري

جزاك الله خير استاذ عبدالله من ابداع الى ابداع تقبل مروري

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

غير من اعدادات الماكرو الى تمكين كافة وحدات الماكرو وكذا بيصير اول ماتفتح الملف يشتغل الماكرو

السلام عليكم جرب هذا الكود Sub ALIDROOS_S() With ورقة1 Q = .Range("A2").End(xlDown).Row + 1 .Range("A" & Q & ":B" & Q).Value = Range(Cells(10, "H"), Cells(10, "I")).Value .Range("A" & Q + 1).Value = Cells(10, 11).Value .Range("C" & Q + 1).Value = Cells(10, 12).Value End With End Sub وهذا كود اخر Sub ALIDROOS() With ورقة1.Columns(1).Rows(2).End(xlDown) .Offset(1, 0) = [H10]: .Offset(1, 1) = [I10] .Offset(2, 0) = [K10]: .Offset(2, 2) = [L10] End With End Sub اختار مايحلو لك

السلام عليكم جرب هكذا ان شاء الله يزبط معاك Public Sub ali() Application.ScreenUpdating = False Dim SH As Worksheet For T = 2 To Sheets.Count Set SH = Sheets(T) Q = SH.Range("B1500").End(xlUp).Row If SH.Range("B" & Q).Value = "الاجمالى" Then GoTo 1 Exit Sub Else SH.Activate Range("B" & Q).Select With SH .Range("A" & Q + 1).Value = TextBox1 .Range("B" & Q + 1).Value = TextBox2 End With End If Sheet1.Activate 1 Next T End Sub تحياتي

السلام عليكم الاخ الفاضل هاني بدر لقبول الليست بوكس عدد اعمده فالعدد الافتراضي هو اعتقد 10 اعمدة فقط ولاكن احاول اتحايل بطريقة اذا زبطت معي ان شاء الله سوف ارفقها في هذا الموضوع واما ماتبقى من طلبك لي نظر فيه مرة اخرى تحياتي

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

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