الخالدي

السلام عليكم ورحمة الله وبركاته الامر Exit Sub هذا الامر ينفذ عند تحقق شرط الدالة If الخاص بالتحقق من ان كل خلايا الشروط فارغة , ويعني الامر الخروج من الكود دون تنفيذ بقية الاوامر اللاحقة في الكود الاوامر Set R1N = Nothing: Set R2N = Nothing: Set R3N = Nothing: Set R4N = Nothing: Set R5N = Nothing وهي خمسة اوامر الا انها كتبت في سطر واحد لكن وضع بين كل امر واخر (:) و تعني فاصل اسطر الاوامر خاصة بإفراغ محتويات الذاكرة من المتغيرات التي انشائها الكود في البداية لذا يجب ان تكون هذه الاوامر اولا حتى تنفذ ثم بعد ذلك الامر Exit Sub بعد كتابة الكود انقر بزر الماوس الأيمن على الزر جلب البيانات ثم اختار الامر تعيين ماكرو ثم تظهر نافذة حدد منها الماكرو المطلوب تعينه للزر ثم انقر موافق. في أمان الله

السلام عليكم ورحمة الله وبركاته وجزاك الله كل خير اخي الكريم الكود صحيح ولكي يعمل معك : في الورقة (عميل)والورقة (صنف) قم بتعين الماكرو (AL_KHALED2) بدلا من الماكرو (AL_KHALEDI) للزر( جلب البيانات) في الورقة (صنف) قم بتصحيح الرقم (2) الى الرقم (3)في الخلية(P8) بالنسبة لشرح الكود كاملا , هذا يحتاج وقت ايضا يحتاج قدرة على توصيل المعلومة وهذا ما افتقده لذا أرى ان تحدد جزء او سطر او نقطة معينة من الكود ثم استفسر عنها من حيث الغرض منها او ماذا تعني او اي اشكال اخر وستجدني والاخوة نرد عليك ان شاء الله كشف حساب-كود2.rar

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

السلام عليكم ورحمة الله وبركاته اخي الكريم في المرفق كود لاستخراج حساب للعميل والصنف خلال فترة محددة او باحد تلك الشروط الشروط والاعمدة الخاصة بتلك بالشروط وكذا الاعمدة المطلوب اظهارها في التقرير وضعت في خلايا بحيث يسهل عليك تعديلها , وفي حال زيادة او انقاص نطاق تلك الخلايا عليك تعديل نطاقاتها في بداية الكود. في أمان الله كشف حساب-كود.rar

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

السلام عليكم ورحمة الله وبركاته بارك الله فيك اخي العزير رجب وبعد الاذن اخي احمد جرب الكود التالي والذي يقوم بتحويل المعادلات العادية في العمود D والعمود F الى معادلات صفيف Sub AL_KHALEDI() On Error Resume Next For Each cl In Range("D:D,F:F").SpecialCells(xlCellTypeFormulas, 23) cl.FormulaArray = Application.Substitute(cl.FormulaLocal, ";", ",") Next End Sub في أمان الله

السلام عليكم جرب الكود في حدث الورقة Private Sub Worksheet_Selectionchange(ByVal Target As Range) Set Rn1 = [A4:A20] Set Rn2 = Rn1.Offset(0, 1) Rn1.ClearContents For i = 1 To Rn1.Rows.Count If Rn1(i) = "" And Rn2(i) <> "" Then N = N + 1 For ii = i To Rn1.Rows.Count If Rn2(ii) = Rn2(i) Then Rn1(ii) = N Next ii End If Next i Set Rn1 = Nothing: Set Rn2 = Nothing End Sub

السلام عليكم ورحمة الله وبركاته اخي الكريم جرب الكود التالي والذي يقوم بحفظ الملف باسم جديد Sub AL_KHALEDI() '======حفظ الملف باسم جديد==== ActiveWorkbook.Save 'حفظ اي تغيرات في الملف الاصلي قبل حفظه باسم جديد (اختياري) S = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name Application.Dialogs(5).Show If ActiveWorkbook.Path & "\" & ActiveWorkbook.Name = S Then Exit Sub 'التحقق من حفظ الملف باسم جديد '=========تحديد وتكوين نطاقات البياتات==== LR = Sheets("DATA").Range("C65000").End(xlUp).Row RW = LR - 6 + 1 If RW < 1 Then Exit Sub Set Rn0 = Sheets("DATA").Range("A6:L" & LR) Set Rn1 = Rn0.Columns(3) Set Rn2 = Rn0.Columns(10) Set Rn3 = Rn0.Columns(11) '=========انشأ مصفوفات التخزين المؤقت في الذاكرة==== ReDim Arr1(1 To RW) ReDim Arr2(1 To RW) ReDim Arr3(1 To RW) '=========استخراج ارصدة الموردين وحفظها في المصفوفات المؤقتة==== For i = 1 To RW If Application.CountIf(Range(Rn1.Cells(1, 1), Rn1.Cells(i, 1)), Rn1.Cells(i, 1)) = 1 Then x = Application.SumIf(Rn1, Rn1.Cells(i, 1), Rn2) - Application.SumIf(Rn1, Rn1.Cells(i, 1), Rn3) If x <> 0 Then r = r + 1 Arr1(r) = Rn1.Cells(i, 1) If x > 0 Then Arr2(r) = x Else Arr3(r) = Abs(x) End If End If End If Next i '=========مسح جدول البيانات وتعبئة جدول البيانات بمحتويات المصفوفات==== If Sheets("DATA").Unprotect = True Then U = 1 'فك حماية الورقة اذا كانت محمية Rn0.ClearContents Rn1.Cells(1, 1).Resize(r).Value = WorksheetFunction.Transpose(Arr1) Rn2.Cells(1, 1).Resize(r).Value = WorksheetFunction.Transpose(Arr2) Rn3.Cells(1, 1).Resize(r).Value = WorksheetFunction.Transpose(Arr3) If U = 1 Then Sheets("DATA").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True 'اعادة حماية الورقة اذا كانت محمية سابقا End If '=========مسح محتويات الذاكرة==== Set Rn0 = Nothing: Set Rn1 = Nothing: Set Rn2 = Nothing: Set Rn3 = Nothing Erase Arr1: Erase Arr2: Erase Arr3 MsgBox ("تم بحمد الله") End Sub ارجوا ان يكون المطلوب في أمان الله Suppliers2012_3.rar

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

السلام عليكم ورحمة الله وبركاته رمضان كريم تقبل الله منا ومنكم الصيام والقيام وصالح الأعمال مرفق محاول للحل حسب فهمي للمطلوب في حفظ الله Suppliers2012_2.rar

السلام عليكم ورحمة الله وبركاته ايضا كود اخر بحلقات تكرارية Sub AL_KHALEDI() A = "A" 'عمود التسلسل B = "B" 'عمود البيانات R = 3 'البيانات تبدأ من الصف '================================================= L = Range(B & 65000).End(xlUp).Row If L < R Then Exit Sub Range(Cells(R, A), Cells(L, A)).ClearContents '================================================= For i = R To L If Cells(i, A) = "" And Cells(i, B) <> "" Then N = N + 1 For ii = i To L If Cells(ii, B) = Cells(i, B) Then Cells(ii, A) = N End If Next ii End If Next i End Sub

السلام عليكم ورحمة الله وبركاته ليس لي كثير من الاطلاع على هذا الموضوع في الملف المرفق مثال على عمل قائمة وعند النقر على ازرار القائمة يتم تنفيذ الماكرو المحدد في اكسل 2007 و2010 تظهر القائمة ضمن علامة التبويب الوظائف الاضافية في أمان الله شريط قوائم مخصص بالاكواد.rar

الفاضل / دغيدى جرب الكود التالي Sub AL_KHALEDI() Rows.EntireRow.Hidden = False Rows([J2]).Resize([K2] - [J2] + 1).EntireRow.Hidden = True End Sub واذا تعني بان الصفوف تبدأ من بداية الجدول (الصف رقم 4) جرب الكود التالي Sub AL_KHALEDI() Rows.EntireRow.Hidden = False Rows([J2]).Offset(3, 0).Resize([K2] - [J2] + 1).EntireRow.Hidden = True End Sub اتمنى ان يكون المطلوب

في السطر If Target.Column = 1 And Target.Row > 9 Then استبدل الرقم 1 بالرقم 4 يصبح السطر بعد التعديل If Target.Column = 4 And Target.Row > 9 Then

وعليكم السلام ورحمة الله وبركاته ولك مثل دعائك لي اخي الفاضل أبو أنس بلغكم الله رمضان وتقبل منكم ومننا صالح الأعمال ونسال الله لك التوفيق في امور الدنيا والدين بارك الله فيك والحمدلله على التوفبق

السلام عليكم ورحمة الله وبركاته بعد اذن الاخوة الكرام بارك الله بكم الاخ أبو حكيم اذا كان المطلوب كود لعمل Select على الخلايا ذات اللون الأزرق التي لها شرط نعم في العمودشرط جرب الكود التالي: Sub AL_KHALEDI() [G2:G27].ColumnDifferences(Comparison:=[G2:G27].Cells(Application.Match("لا", [G2:G27], 0), 1)).Offset(0, -5).Select End Sub الكود يعمل – بشرط- ان البيانات في العمودشرط ثوابت (لا تحتوي علي معادلات) وانها تتكون فقط من (نعم و لا) او جرب الكود التالي والذي يعمل بدون الشروط السابقة Sub AL_KHALEDI() On Error Resume Next Set Rn_G = [G2:G27] For r = 1 To Rn_G.Rows.Count If CStr(Rn_G(r)) = "نعم" Then If Rn_A Is Nothing Then Set Rn_A = Rn_G(r) Else Set Rn_A = Union(Rn_A, Rn_G(r)) Next r Rn_A.Offset(0, -5).Select Set Rn_G = Nothing: Set Rn_A = Nothing End Sub في أمان الله

أللهم رب الناس إذهب البأس وشف أنت الشافي لا شفاء إلا شفاؤك شفاء لا يغادر سقما نسأل الله العظيم رب العرش العظيم أن يشفها

السلام عليكم ورحمة الله وبركاته اخي الكريم ملاحظتك في الملف: (لو هنحزف محتوى الخليه A23يبقى هيتم حزف الصف من A23 الى D23 هذا لو تم الضغط على نعم التى ستظهر مع الرساله التحزيريه ام لو تم الضغط على لا يتم الابقاء على محتو الخليه كما هى) الملف المرفق في المشاركة السابقة يقوم بهذا العمل - لكن كان هناك خطأ في الملف من حيث عدم ادراج صف جديد وتم اصلاح الملف في المرفق ارجوا ان يكون المرفق هو المطلوب اوتحدد طلبك بوضوح اكثر او ربما احد الاخوة يفهم طلبك فيساعدك في أمان الله اضافة سطر5-2.rar

جرب المرفق اضافة سطر5.rar

السلام عليكم ورحمة الله وبركاته بارك الله فيك اخي mahmoud-lee وبعد الاذن اخي أبو أنس جرب المرفق ثم ادخل الشروط السابقة في أمان الله تنسيق شرطي واحد بشرطين مختلفين.rar

السلام عليكم ورحمة الله وبركاته بارك الله فيك اخي الفاضل / ابراهيم ساحاول في طلبك ان شاء الله ارجوا التوضيح بالنسبة للجدول الثاني : يضاف سطر جديد عند الادخال في خلية العمود الاول(F) ام خلية العمود الثاني(G) ظهور رسالة تاكيد الحذف عند حذف بيانات الخلايا في العمود الاول(F) ام العمود الثاني(G) في أمان الله

وعليكم السلام ورحمة الله وبركاته جزاك الله كل خير اخي الفاضل / أبو أنس ناصر حاجب ولك مثل دعائك لي تمنايتي لك بالتوفيق جزاك الله خيرا اخي الفاضل / الشهابي لظروف عملي والانقطاع المتكرر للكهرباء ان شاء لله الشرح في مشاركة قادمة تمنايتي لك بالتوفيق

السلام عليكم ورحمة الله وبركاته حسب فهمي للمطلوب جرب الكود المرفق اضافة سطر4.rar

السلام عليكم ورحمة الله وبركاته مشكور اخي الفاضل على الملف الممتاز لكن الملف لايعمل لكي يعمل الملف اعتقد انه يجب استبدال الحرف (A) بالرقم(1) و استبدال الحرف(B) بالرقم (2) في أمان الله

السلام عليكم ورحمة الله وبركاته بارك الله فيك استاذنا ياسر حافظ وارجوا ان يلبي المرفق طلب أخينا ابراهيم في أمان الله اضافة سطر3.rar