جميع اسماء الاطعمة المذكورة امام المطعم فى خلية واحدة

[ابو حبيبة وحنين]

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

تجميع اسماء الاطعمة المذكورة امام المطعم فى خلية واحدة.rar

تم تعديل يناير 24, 2012 بواسطه hulkamir

[طارق محمود]

السلام عليكم

أخي العزيز

ضع الكود التالي في حدث الورقة

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$F$4" Then Exit Sub

LR = [A10000].End(xlUp).Row

[B1].Copy ([G11])

Range("A1:B" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[F3:F4], CopyToRange:=[G11], Unique:=True


con = WorksheetFunction.CountA([G11:G20])

Select Case con

   Case 1: Exit Sub

   Case 2: x = [G12]: GoTo 10

   Case Else

	x = [G12]

	For i = 13 To [G10000].End(xlUp).Row

	   x = x & " - " & Cells(i, "G")


	Next



End Select

10

[E5] = x

  [G10:G100].FillDown

End Sub

أو تفضل المرفق وبه المطلوب

تجميع اسماء الاطعمة المذكورة امام المطعم فى خلية واحدة.rar

[عبدالله المجرب]

ما شاء الله استاذ طارق

كود جميل جداً

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

مشعارف اقولك ايه استاذ طارق

بس كوود احترافي

جزاك الله كل خير

[ابو حبيبة وحنين]

السلام عليكم

أخي العزيز

ضع الكود التالي في حدث الورقة

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$F$4" Then Exit Sub

LR = [A10000].End(xlUp).Row

[B1].Copy ([G11])

Range("A1:B" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[F3:F4], CopyToRange:=[G11], Unique:=True


con = WorksheetFunction.CountA([G11:G20])

Select Case con

   Case 1: Exit Sub

   Case 2: x = [G12]: GoTo 10

   Case Else

	x = [G12]

	For i = 13 To [G10000].End(xlUp).Row

	   x = x & " - " & Cells(i, "G")


	Next



End Select

10

[E5] = x

  [G10:G100].FillDown

End Sub

أو تفضل المرفق وبه المطلوب

جزاكم الله خيرا

ولكن انا اريد عمل هذا بالمعادلات وليس بلغة البرمجة .... وشكرا على مجهودك الواضح يا عبقرى

[فضل حسين]

البشمهندس / طارق

كود رائع وجميل وقفزة رائعة فى الاكواد لتحقيق المطلوب . بارك الله فيك وزادك علما وجزاك الله كل خير على هذا الكود العظيم الرائع .

ولكن لى ملحوظة بسيطة جدا برجاء تنفيذها ليصبح الكود يحقق كل المطلوب منه .

والملحوظة هى فى حالة كتابة اسم الفرع ولم يكتب امام اسم الفرع الطلبات . أى امام اسم الفرع خالى ( الخلية فارغة ) هنا يعطى نتائج غير مضبوطه .

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

فى النهاية اقول لك الف مبروك على هذا العمل الرائع فهو عمل جميل وعظيم مثل صاحبه .

فى انتظار رد سيادتكم الكريم

[Eid Mostafa]

أخى العزيز / طارق

السلام عليكم ورحمة الله وبركاته

أحييك على هذا الحل الرائع الذى لا يأتى إلا من عبقرى مثلك

كما أنتهز الفرصة وأحييك مرة أخرى على سعة صدرك دائماً وهذه ليست بمجامله.

فدائماً أجد إفاداتك من أقيم وأروع ما تكون

وبالمصرى (ياريت كلنا نبقى زيك)

وفقك الله

أخوك

عيد مصطفى

[طارق محمود]

السلام عليكم

أخواني الأحباب

جزاكم الله خيرا الجزاء

أشكركم جميعا علي كلماتكم الطيبة ومروركم الكريم

أخي السائل

تفضل حل بالمعادلات

ولكن يعيبه اننا نحتاج لللمساحة الملونة بالأصفر ، لاتدخلها في ملفك ولافي طباعتك

فهي مهمة لإتمام المعادلات

يمكنك إخفاؤها

تفضل الملف

تجميع اسماء الاطعمة المذكورة امام المطعم فى خلية واحدة_معادلات.rar

[عبدالله المجرب]

البشمهندس / طارق

كود رائع وجميل وقفزة رائعة فى الاكواد لتحقيق المطلوب . بارك الله فيك وزادك علما وجزاك الله كل خير على هذا الكود العظيم الرائع .

ولكن لى ملحوظة بسيطة جدا برجاء تنفيذها ليصبح الكود يحقق كل المطلوب منه .

والملحوظة هى فى حالة كتابة اسم الفرع ولم يكتب امام اسم الفرع الطلبات . أى امام اسم الفرع خالى ( الخلية فارغة ) هنا يعطى نتائج غير مضبوطه .

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

فى النهاية اقول لك الف مبروك على هذا العمل الرائع فهو عمل جميل وعظيم مثل صاحبه .

فى انتظار رد سيادتكم الكريم

السلام عليكم

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

اخي فضل

جرب الكود يعد التعديل

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$F$4" Then Exit Sub

[E5:E100].ClearContents

A = 5

LR = [A10000].End(xlUp).Row

[B1].Copy ([G11])

Range("A1:B" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[F3:F4], CopyToRange:=[G11], Unique:=True

con = WorksheetFunction.CountA([G11:G20])

Select Case con

   Case 1: [E5:E100].ClearContents: GoTo 10

   Case Else

    X = [G12]

    For i = 13 To [G10000].End(xlUp).Row

	   X = X & " - " & Cells(i, "G")


    Next

For Each C In Split(X, " - ")

Cells(A, 5) = C

A = A + 1

Next

End Select

10

  [G10:G100].FillDown

End Sub

[طارق محمود]

السلام عليكم

ردا علي أخي فضل

ملحوظة هى فى حالة كتابة اسم الفرع ولم يكتب امام اسم الفرع الطلبات . أى امام اسم الفرع خالى ( الخلية فارغة ) هنا يعطى نتائج غير مضبوطه .

أضف السطر التالي في أول الكود

[E5].ClearContents

ان تظهر الطلبات ليس كلها فى خلية واحدة ولكن فى خلايا اسفل بعضها .

أضف أبوستروف قبل السطر الأخير من الكود لإلغاؤه ليصبح

'[G10:G100].FillDown

أو إلغيه وفي النهاية يكون الكود

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$F$4" Then Exit Sub

[E5].ClearContents

LR = [A10000].End(xlUp).Row

[B1].Copy ([G11])

 Range("A1:B" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[F3:F4], CopyToRange:=[G11], Unique:=True


con = WorksheetFunction.CountA([G11:G20])

Select Case con

  Case 1: Exit Sub

   Case 2: x = [G12]: GoTo 10

   Case Else

    x = [G12]

    For i = 13 To [G10000].End(xlUp).Row

	   x = x & " - " & Cells(i, "G")


    Next



End Select

10

[E5] = x


End Sub

[عبدالله المجرب]

السلام عليكم

واثراءً للموضوع هذا الملف مرفق به حل بالمعادلات

تجميع اسماء الاطعمة المذكورة امام المطعم فى خلية واحدة.rar

[فضل حسين]

الاستاذان الكبيران / حبيب قلبى المايسترو

البشمهندس طارق

يعنى والله مش عارف اقول ايه . بصراحة انتم مش حرمنا من حاجة خالص . واحنا مش عارفين نعمل معاكم ايه امام ابداعاتكم وعطائكم الغير عادى .

اسمحوا لى بكل الحب ان ادعوا الله ان يزيدكم علما ويزيد من امثالكم وان يجزيكم الله خير الجزاء عن هذة الاعمال الرائعة مثلكم. كل الحب والاحترام والتقدير للاستاذان الكبيران.

والف شكر ..