الـعيدروس

الاخ الفاضل ابو الآء برنامج جميل وفيه شغل كبير بارك الله فيك وجزاك خيرا تقبل مروري

القوسين تعبير عن معادلة صفيف

السلام عليكم Sub A_qtr() Dim الربع%, الدرجة% Dim Rn As Range ''*************** ' حط قيمة الدرجة الدرجة = 100 For Each Rn In [A2:A1000] ' المدى المراد تطبيق الكود عليه If Val(Rn) < (الدرجة / 4) Then Rn.Font.Italic = True Next End Sub

استخدم معادلة < SUBTOTAL > كالاتي =SUBTOTAL(109;B9:B1000) =SUBTOTAL(109;C9:C1000)

السلام عليكم الاخ الفاضل طارق زكريا حبذا ادارج عمود مساعد في ورقة ( بيع كروت ) وبه رقم الفاتورة كما هو في ورقة ( شراء كروت ) كي يسهل تتبع الفواتير المراد حذفها تحت شرط اخر تاريخ عموما تم عمل حذف فاتورة معينه لورقة ( شراء كروت ) الى ان تنورنا حبتين في ما سبق ذكره جرب المرفق ارجو التجربه تحياتي حذف بيانات_A.rar

ارفق مثال اخي الكريم او الكود المراد التعديل عليه تحياتي

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

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

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

السلام عليكم الاستاذ القدير عبدالله باقشير عمل متقن جزاك الله خيرا بعد اذنك كنت قد عملت على طلب الاخ نرفق الملف على يستفيد منه بعض الاخوة 11_A.rar

كما تفضل استاذنا الحبيب طارق محمود وفي حال اردت تضليل اسطر متفرقة استعن بزر Ctrl + الضغط على الاسطر المراده بالماوس الايمن واحد تلو الاخر ثم اترك زر الـ Ctrl واشر بالماوس حتى يظهر السهمين وسحب بينطبق عرض الصف على الاسطر المضلله تحياتي

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

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Set Rm = Range("A3:L10000") If Not Intersect(Target, Rm) Is Nothing Then With Target c = ورقة2.[A65536].End(xlUp).Offset(1, 0).Row Range(Cells(.Row, 1), Cells(.Row, 12)).Copy (ورقة2.Cells(c, 1)): .EntireRow.Delete End With End If End Sub السلام عليكم او في حدث الدبل كليك ( نقر مرتين ) انسخ الكود في حدث الورقة

اخي الحبيب عبدالله المجرب تقبل الله صيامكم وقيامكم بارك الله فيك وزادك علما موضوعاتك للشروحات تفيد الكثير فأنت تعمل عمل ووتقنه تقبل مروري

السلام عليكم بعد اذن الاخوة الاحبه كنت عملت على ملفك بالامس حاولت ادخل على المنتدى لايفتح معي جرب المرفق A_ne.rar

السلام عليكم Private Sub Worksheet_Activate() Application.ScreenUpdating = False Dim My_a As Range Dim R As Range '*********************** ' My_a ' حطينا المدى في متغير المسمى ' b3:b1500 'التحديد الحالي من ' بالامكان تغيره الى اي صف تريد Set My_a = Range("b3:b1500") '*********************** ' حلقه تكراريه من اول صف للمدى الى اخر صف For Each R In My_a 'الصف شرط اذا الخليه صفريه او فارغه يخفي الصف والعكس إظهار If R.Value = 0 Or R = Empty Then R.EntireRow.Hidden = 1 _ Else R.EntireRow.Hidden = 0 ' نهاية الحلقه Next Application.ScreenUpdating = True End Sub

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

مبروك عليك الترقية اخي شوقي ربيع الى الامام دوماً تقبل مروري

او هكذا في حدث التغير Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A2:A1000]) Is Nothing Then If IsDate(Target) Then Target.Offset(0, 1).Value = Format(Target, "yyyymmdd") End If End Sub

المعادلات التي في ملف الايصالات نتائجها سليمه التي في عمود AH و AI نرجو توضيح الخطاء الموجود لديك

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

السلام عليكم اخي الحبيب حماده عمر اسعدني مرورك وكلماتك الطيبه ودنا نتواجد يوميا في منتدانا الغالي ولاكن الظروف والشواغل وعما قريب إن شاء الله نستعيد النشاط كما السابق الاخ الفاضل ابو محمد اشرف اشكرك على مرورك العطر اخي nicola حسب فهمي لما تريد حدد الاعمدة المراده من السطر التالي في الكود Ar = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) على اساس 1 يعتبر العمود B وهكذا تحياتي

السلام عليكم جرب التعديل التالي Private Sub CommandButton1_Click() Dim V%, L_r% Dim M Dim Q, F, Rw Dim Ar_r(), Ar() Dim j&, L_rw, i& ListBox1.Clear On Error Resume Next If TextBox1 = "" Then ListBox1.Clear Else T = 0 M = Me.TextBox1 With Sheet1 L_r = .Cells(.Rows.Count, "B").End(xlUp).Row Set Q = .Range("B3:B" & L_r).Find(M) ReDim Preserve Ar_r(0 To 1000, 0 To 11) If Not Q Is Nothing Then F = Q.Address Do If WorksheetFunction.Search(M, Q, 1) = 1 Then Ar = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) For j = 0 To UBound(Ar) ii = Ar(j) Ar_r(T, j) = Q.Cells(1, ii) Next j T = T + 1 End If Set Q = .Range("B3:B" & L_r).FindNext(Q) Loop While Not Q Is Nothing And Q.Address <> F For i = 0 To UBound(Ar_r, 1) L_rw = 0 For j = 0 To 11 L_rw = Ar_r(i, j) Next j ReDim Preserve Ar_r(0 To i, 0 To j) Ar_r(i, j) = L_rw Next i Me.ListBox1.List = Ar_r() End If End With End If End Sub

السلام عليكم شاهد المرفق على الرابط التالي http://www.4shared.com/rar/F7IYObiM/Xl_Rean_1.html?

السلام عليكم الاخ الاستاذ ضاحي الغريب عمل مميز ومتقن بارك الله فيك وجزاك خيرا تقبل مروري