خالد الرشيدى

السلام عليكم اخى الكريم استبدل الكود الخاص بالبحث بصفحه ( تقرير حركة صنف ) بهذا الكود .. عله المطلوب تماماً Sub Find_All() Dim date1 As Date, date2 As Date Dim sCode As Integer, T As Variant, x As Integer, LR As Long date1 = CDate(Sheets("تقرير صنف").Range("F4")) date2 = CDate(Sheets("تقرير صنف").Range("F5")) sCode = Sheets("تقرير صنف").Range("F3") '.Text Sheets("تقرير صنف").Range("E9:K" & Range("E" & Rows.Count).End(xlUp).Row + 1).ClearContents x = 9 Application.ScreenUpdating = False For Each T In ThisWorkbook.Worksheets If T.Name = "مخزن الصرف" Or T.Name = "مخزن الاضافة" Then LR = T.Cells(Rows.Count, 5).End(xlUp).Row For i = 9 To LR If CDate(T.Cells(i, 5)) >= date1 And CDate(T.Cells(i, 5)) <= date2 And CStr(T.Cells(i, 6)) = CStr(sCode) Then T.Range("E" & i & ":K" & i).Copy ورقة16.Range("E" & x).PasteSpecial Paste:=xlPasteValues ورقة16.Range("D" & x) = x - 8 x = x + 1 End If Next End If Next Application.CutCopyMode = False Application.ScreenUpdating = True End Sub مخزن.rar

السلام عليكم بعد اذن استاذنا القدير أ / محمد صالح حل اخر بطريقة التنسيق الشرطي ( منع الادخال الا بتحقق شرط معين ) Book1.rar

السلام عليكم انظر المرفق التالى وابدي ملاحظاتك wsh.rar

جزاك الله خيراً اخي الكريم علي هذا الدعاء الطيب جزاك الله بمثله وزياده كل عام وانتم بخير

السلام عليكم اخى الكريم - فى ذهني فكرتان - الاول في السطر الخاص ب ( ارقام الاعمده المطلوب نقلها ) ستلاحظ ان هناك 5و5و5 يمكنك ان تستبدل الاولى والثانيه برقم عمود لا يحوي بيانات وليكن 104 مثلاً -- هذه فكره - الثانية -وهى قابله للتطوير - لا احبذ ان تعمل بها بهذا الملف - ولكن - سأطرحها لربما شارك اساتذتى بالمنتدي بطريقة افضل منها وعندها ستمثل لى إضافة - وهى تقسيم مصفوفة النتائج الى جزئين - الجزء الاول يعبأ بالنطاق a:O , الجزء الثاني R:AZ وذلك بإستبدل الكود الخاص بتعبئة المصفوفة .Range("A11").Resize(j - 1, UBound(temp, 1)).Value = temp بهذين الكودين ( مع حذف الخمسة الاولى والثانية الموجوده بارقام الاعمده المطلوب نقلها ) .Range("A11").Resize(j - 1, 15).Value = Application.Index(temp, [row(1:7000)], Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)) .Range("R11").Resize(j - 1, c - 14).Value = Application.Index(temp, [row(1:7000)], Array(16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50))

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

السلام عليكم تفضل المطلوب على قدر فهمي له Test_2.rar

السلام عليكم حقيقه كود ولا اروع.. وليس بالجديد عليك ا. زيزو فدائما اعمالك رائعه ولكن اعتقد ان المستخدم يريد اظهار عمود اخر ضمن النتائج هو عمود الملاحظات لم يشمله الكود.. ايضا مسح محتوي نطاق النتيجه في بدايه الكود ليستقبل الجديد تقبلوا خالي تحياتي وتقديري

السلام عليكم اطلع علي الرابط التالي لربما تجد به طريقه ما.. لم اجربه لان تواصلي من الهاتف تقبلوا مروري وتحياتي

اخي الكريم راجع المرفق كأحد طرق الحل وابدي ملاحظاتك المصنف2.rar

السلام عليكم اخى الكريم هل تقصد الرصيد التراكمي الخاص بكل عميل ام لكل العملاء ؟؟؟ الرصيد التراكمي -- ( طرح اجمالى المدين من اجمالى الدائن - بالاضافه الى العمليه الجديده في كل مرة -- اليس كذلك ؟؟؟ )

السلام عليكم استبدل الرقم 12 الموجود باخر المعادلة ب 18

السلام عليكم استبدل الكود الخاص بإذن الصرف بهذا الكود - كأحد طرق الحل Sub Test() Dim positve As Boolean, i As Long Do While Cells(i + 9, 10).Value <> "" If Cells(i + 9, 10).Value > 0 Then positve = True MsgBox Cells(i + 1, 10).Address & " " & " يوجد رقم موجب بالخلية" Exit Do End If i = i + 1 Loop If i And positve = False Then Application.ScreenUpdating = False azsh = ورقة7.Range("k100000").End(xlUp).Row + 1 ورقة5.Range("e9:k23").Copy ورقة7.Cells(azsh, 5).PasteSpecial Paste:=xlPasteValues MsgBox "تم الترحيل بنجاح", vbDefaultButton1, "الترحيل" ورقة5.Range("e9:k23").SpecialCells(xlCellTypeConstants, 23).ClearContents Application.CutCopyMode = False Application.ScreenUpdating = True End If End Sub

انت علي حق.. عموما الحمد لله ان تم المطلوب

السلام عليكم على قدر ما فهمت - اليك احد الطرق - ضع المعادلة التالية بالخلية E4 ثم اسحبها لاسفل =VLOOKUP(D4,$H$4:$I$11,2,0)

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

السلام عليكم يبحث عن كلمة الاجمالى - مفهومة -- ولكن يضيف صف ؟؟ اى صف -- اتقصد يضيف الاجمالى بالاعمدة المجاورة ؟

السلام عليكم اخي الكريم جرب الكود التالى -- قم باضافه قيم ثم اكتب Total ولاحظ النتائج Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Column = 3 And Target.Value Like "Total" & "*" Then Dim a As Range Set a = Range("C:C").Find("Total", after:=Cells(Target.Row, 3), searchdirection:=xlPrevious) Cells(Target.Row, 4).Value = WorksheetFunction.Sum(Range("D" & a.Offset(1, 0).Row & ":D" & Target.Offset(-1, 0).Row)) Cells(Target.Row, 5).Value = WorksheetFunction.Sum(Range("E" & a.Offset(1, 0).Row & ":E" & Target.Offset(-1, 0).Row)) End If End Sub جمع.rar

اخي الكريم زكرت بالاعلى انى لم استخدم اى كود وانما خاصيه ( Format as Table ) -- بقائمة Home -- وتتيح للمستخدم امكانيات كبيره عند التعامل مع كميات كبيره من البيانات - والتعامل معها بسيط - اطلع حضرتك على اليوتيوب لمعرفه بعض المعلومات عنها -- بالنسبه ان حضرتك بتقول ان حتى العمود D يكون قائمة منسدله -- كيف وسبق ان حضرتك قولت ان حدث انطلاق الكود هو وضع قيمه بهذا العمود كما انهم قيمتين وفقط لا اعتقد انك بحاجه الى قائمة منسدلة يمكنك ان تدخل ما تشاء من المعادلات والى اى عمود تريد وسيتم نسخها بشكل تلقائي الى اسفل بمجرد ادخال قيمة الى اى خليه - تقبل مرورى وتحياتى

السلام عليكم بعد اذن اساتذتى الكرام الملف ليس بحاجه الى معادلات الصفيف -- و طبيعة الملف ان اخر عمليه للمنتج ستصادف رقم الحركة الاكبر بالنسبه له - لهذا من الممكن استخدام الدالة Lookup =IFERROR(LOOKUP(2,1/($B$2:$B$14=E3),$A$2:$A$14),"") تقبلوا مروري وتحياتى

السلام عليكم اخى الكريم لما الحاجه الى كل هذه الاكواد وهناك الخاصيه الرائعه (( Format as Table )) - مع كل سطر جديد ستجد انها طبقت القوائم المنسدلة والمعادلات والتنسيقات -- فقط ادخل بالخلية D6 احد القيم 155- 18 ولاحظ النتائج -- ليس هذا وفقط بل اذا قمت باضافه كشف اخر سيتم تحديث القائمة المنسدلة باسم الكشف الجديد بشكل تلقائي khaled-tabel.rar

السلام عليكم اليك الدالة المعرفة التالية Public Function ConcatenateRange(rRange As Range, Optional sDelimiter As String) As String Dim c As Variant For Each c In rRange.Cells ' اذا اردت ان تتجاهل المعادلة الخلايا الفارغة احذف تلك الشرطه ' من السطر التالى والسطر القبل قبل الاخير فوضع تلك الشرطة امام اي سطر من الاكواد يعنى انه سطر للشرح او ملاحظه وليس كود سينفذ ' If Not c.Value = "" Then If ConcatenateRange = "" Then ConcatenateRange = c.Value Else ConcatenateRange = ConcatenateRange & sDelimiter & c.Value End If ' End If Next c End Function Employee_4.rar

لا عليك اخى الكريم يكفينى ان حضرتك عرفت ما تريد الان .. واعتقد ان حضرتك اخذت فكره عن العديد من الامور ... تقبل مرورى وتحياتى

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

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