ahmadalweshah قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 السلام عليكم اولا اتقدم اليكم بالشكر الجزيل لهذا المنتدى الطيب الحقيقه انا اول مره اشارك فيه مع اني مشترك فيه من زمان حاليا انا شغال عموضوع بسيط وهو ملف اكسل فيه بيانات عن مبيعات ومشتريات مشغل طوب واسمنت واجهت مشكله وحده وهي انه الوالد طلب مني اضيفله زر بحث في الملف موجود فيه بيانات كل العميل مع مشترياته بس يبحث عنه يعني مثلا بالجداول موجود العميل احمد اكثر من مره لكن هو بده بس يكبس على البحث ويكتب احمد يظهر اله جميع مشتريات احمد الموجوده في الشيت ارجوا تكون وصلتكم المعلومه وشكرا الكم مره اخرى ahmad.rar رابط هذا التعليق شارك More sharing options...
الجموعي قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 إليك ما طلبت ahmad.rar 1 رابط هذا التعليق شارك More sharing options...
ibn_egypt قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 اخى الفاضل بعد إذن أخى الكريم أ.الجموعي، فحله منتهي البساطة والروعة .. ولإثراء الموضوع مرفق أيضا حل آخر تحياتي ahmad.rar 1 رابط هذا التعليق شارك More sharing options...
الجموعي قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 اخى الفاضل بعد إذن أخى الكريم أ.الجموعي، فحله منتهي البساطة والروعة .. ولإثراء الموضوع مرفق أيضا حل آخر تحياتي كود رائع جدا أستاذي الكريم القائمة المنسدلة في الخلية F1 كيف عملتها من أين تستدعي بيانتها ياريت شرح بسيط رابط هذا التعليق شارك More sharing options...
ibn_egypt قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 كود رائع جدا أستاذي الكريم القائمة المنسدلة في الخلية F1 كيف عملتها من أين تستدعي بيانتها ياريت شرح بسيط انظر في حدث ال WorkSheet_Activate أخى الجموعي بنفس الورقة ( كشف حساب عميل ) تحياتي رابط هذا التعليق شارك More sharing options...
الجموعي قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 كود رائع جدا أستاذي الكريم القائمة المنسدلة في الخلية F1 كيف عملتها من أين تستدعي بيانتها ياريت شرح بسيط انظر في حدث ال WorkSheet_Activate أخى الجموعي بنفس الورقة ( كشف حساب عميل ) تحياتي شكرا أخي الكريم ياريت شرح مبسط لهذا الكود المعقد رابط هذا التعليق شارك More sharing options...
ibn_egypt قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 شكرا أخي الكريم ياريت شرح مبسط لهذا الكود المعقد أخى الفاضل أ.الجموعي لا أجيد الشرح ولكن هذه محاولة مني لإيصال الفكرة...أرجو أن أكون وفقت في ذلك Sub GetUniques() 'عند حدوث أى خطأ يذهب الى 1 'وهناك ننهي الكود On Error GoTo 1 'تعريف المتغيرات Dim S As Object, c, m As Variant, i, k, LastR, LastR2 As Long, ws, ws2 As Worksheet Application.ScreenUpdating = False 'تعريف ورقة العمل التى سنجلب منها القائمة المنسدلة Set ws = ThisWorkbook.Sheets("المبيعاتSales") 'تعريف ال 'Scripting Dictionary 'الذي سيحوي البيانات الفريدة Set S = CreateObject("Scripting.Dictionary") 'تعريف الورقة التى ستكون بها القائمة المنسدلة Set ws2 = ThisWorkbook.Sheets("كشف حساب عميل") 'ايجاد اخر صف بالورقة التى سنحضر منها البيانات LastR = ws.Cells(Rows.Count, 4).End(xlUp).Row 'عمل حلقة تكرارية من بداية النطاق الذي به البيانات حتى اخر صف بهذا النطاق 'القيم الفريدة يتم وضعها في ال 'Scripting Dictionary 'حتى يتم ايجاد البيانات بدون أى تكرار m = ws.Range("D4:D" & LastR) For k = 1 To UBound(m, 1) S(m(k, 1)) = 1 Next k 'أصبح لدينا الآن 'Scripting Dictionary 'يحوي القيم الفريدة في النطاق الذي حددناه 'نذهب الى ورقتنا الأصلية التى ستحوي القائمة المنسدلة 'نمسح البيانات من 'z500 to z700 ws2.Range("Z500:Z700").ClearContents 'نحذف القائمة المنسدلة الموجودة بالخلية 'F1 ws2.Range("F1").Validation.Delete 'بنقول هنا بداية من 'Z500 'وبطول عدد القيم الموجودة بال 'Scripting Dictionary 'قم بكتابة القيم الموجودة به ws2.Range("Z500").Resize(S.Count) = Application.Transpose(S.keys) 'كده البيانات الفريدة أصبحت موجودة لديك بالشيت 'بداية من الخلية 'Z500 'نشوف قيمة آخر صف بعد ان تم وضع البيانات LastR2 = ws2.Cells(Rows.Count, "Z").End(xlUp).Row 'يتم عمل قائمة منسدلة في الخلية 'F1 'بدايتها الخلية 'z500 'ونهايتها 'z&LastR2 'الذي حصلنا عليه With ws2.Range("F1").Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _ Formula1:="=$Z$500:$Z$" & LastR2 'تجاهل الفراغات في القائمة المنسدلة .IgnoreBlank = True .InCellDropdown = True End With Application.ScreenUpdating = True 1 End Sub تحياتي رابط هذا التعليق شارك More sharing options...
الجموعي قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 شكرا أخي الكريم ياريت شرح مبسط لهذا الكود المعقد أخى الفاضل أ.الجموعي لا أجيد الشرح ولكن هذه محاولة مني لإيصال الفكرة...أرجو أن أكون وفقت في ذلك Sub GetUniques() 'عند حدوث أى خطأ يذهب الى 1 'وهناك ننهي الكود On Error GoTo 1 'تعريف المتغيرات Dim S As Object, c, m As Variant, i, k, LastR, LastR2 As Long, ws, ws2 As Worksheet Application.ScreenUpdating = False 'تعريف ورقة العمل التى سنجلب منها القائمة المنسدلة Set ws = ThisWorkbook.Sheets("المبيعاتSales") 'تعريف ال 'Scripting Dictionary 'الذي سيحوي البيانات الفريدة Set S = CreateObject("Scripting.Dictionary") 'تعريف الورقة التى ستكون بها القائمة المنسدلة Set ws2 = ThisWorkbook.Sheets("كشف حساب عميل") 'ايجاد اخر صف بالورقة التى سنحضر منها البيانات LastR = ws.Cells(Rows.Count, 4).End(xlUp).Row 'عمل حلقة تكرارية من بداية النطاق الذي به البيانات حتى اخر صف بهذا النطاق 'القيم الفريدة يتم وضعها في ال 'Scripting Dictionary 'حتى يتم ايجاد البيانات بدون أى تكرار m = ws.Range("D4:D" & LastR) For k = 1 To UBound(m, 1) S(m(k, 1)) = 1 Next k 'أصبح لدينا الآن 'Scripting Dictionary 'يحوي القيم الفريدة في النطاق الذي حددناه 'نذهب الى ورقتنا الأصلية التى ستحوي القائمة المنسدلة 'نمسح البيانات من 'z500 to z700 ws2.Range("Z500:Z700").ClearContents 'نحذف القائمة المنسدلة الموجودة بالخلية 'F1 ws2.Range("F1").Validation.Delete 'بنقول هنا بداية من 'Z500 'وبطول عدد القيم الموجودة بال 'Scripting Dictionary 'قم بكتابة القيم الموجودة به ws2.Range("Z500").Resize(S.Count) = Application.Transpose(S.keys) 'كده البيانات الفريدة أصبحت موجودة لديك بالشيت 'بداية من الخلية 'Z500 'نشوف قيمة آخر صف بعد ان تم وضع البيانات LastR2 = ws2.Cells(Rows.Count, "Z").End(xlUp).Row 'يتم عمل قائمة منسدلة في الخلية 'F1 'بدايتها الخلية 'z500 'ونهايتها 'z&LastR2 'الذي حصلنا عليه With ws2.Range("F1").Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _ Formula1:="=$Z$500:$Z$" & LastR2 'تجاهل الفراغات في القائمة المنسدلة .IgnoreBlank = True .InCellDropdown = True End With Application.ScreenUpdating = True 1 End Sub تحياتي lماشاء الله الفكرة وصلت بارك الله فيك أستاذي الكريم قم بمراجعة مرفقك به مشكل وهو عند البحث مرة ثانية لا يمسح البيانات الأولى رابط هذا التعليق شارك More sharing options...
ibn_egypt قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 lماشاء الله الفكرة وصلت بارك الله فيك أستاذي الكريم قم بمراجعة مرفقك به مشكل وهو عند البحث مرة ثانية لا يمسح البيانات الأولى اخى الفاضل أ.الجموعي على اى اصدار اوفيس تعمل .. لا يوجد لدى اى مشكلة ... والكود يمسح البيانات قبل ان يحضر البيانات الجديدة حدد على الخلية A6 وتأكد أن البيانات بتنسيق جدول ولها الاسم KATABLE كما في الصورة او ممكن تريح نفسك وتستخدم الملف المرفق .. حيث تم تحويل الجدول الى نطاق عادى تحياتي ahmad.rar رابط هذا التعليق شارك More sharing options...
الجموعي قام بنشر يناير 18, 2015 مشاركة قام بنشر يناير 18, 2015 lماشاء الله الفكرة وصلت بارك الله فيك أستاذي الكريم قم بمراجعة مرفقك به مشكل وهو عند البحث مرة ثانية لا يمسح البيانات الأولى اخى الفاضل أ.الجموعي على اى اصدار اوفيس تعمل .. لا يوجد لدى اى مشكلة ... والكود يمسح البيانات قبل ان يحضر البيانات الجديدة حدد على الخلية A6 وتأكد أن البيانات بتنسيق جدول ولها الاسم KATABLE كما في الصورة او ممكن تريح نفسك وتستخدم الملف المرفق .. حيث تم تحويل الجدول الى نطاق عادى تحياتي أوفيس 2010 بمرفقك الجديد حيث تم تحويل الجدول لنطاق عادي الكود يعمل جيدا اما بالنسبة للملف السابق شاهد الصورة رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.