قائمة بالاسماء مكونة من عمودين فى شيتين مختلفين

[عادل ابوزيد]

اساتذتى الكرام

بالمرفق المطلوب :
عمل قائمة تجميعية باسماء العملاء من شيت خروج نقدية العمود g , شيت دخول نقديه العمود g
بحيث تظهر فى شيت المتعاملين فى النقدية الاسماء بالعمود d مع استبعاد المكرر من الاسماء والفراغات

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.rar

[سليم حاصبيا]

 عسى ان يكون هذا المطلوب

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين (SALIM).rar

[عادل ابوزيد]

الاستاذ الفاضل سليم

مجهزد جبار ومعادلات جميله وافكار رائعة ما شاء الله عليك

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

برجاء النظر فى هذه المعلومة

تقبل منى كل الشكر والتقدير على مجهودك الكبير

[ibn_egypt]

الاستاذ الفاضل سليم

مجهزد جبار ومعادلات جميله وافكار رائعة ما شاء الله عليك

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

برجاء النظر فى هذه المعلومة

تقبل منى كل الشكر والتقدير على مجهودك الكبير

 

اخى الفاضل أ.عادل

 

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

 

وبعد إذن أخى الفاضل سليم، من باب التنوع جرب الملف المرفق بالكود وليس المعادلات

 

تحياتي   

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.rar

[عادل ابوزيد]

الاستاذ الفاضل المحترم

ibn_egypt

كود رااااااااااااااااااااااااااااائع وفكرة ممتازه بارك الله فيك ولك ورزقك من حيث لا تحتسب

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

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

تقبل منى كل الشكر والتقدير على مجهوداتك الرائعه وجعلها الله فى ميزان حسناتك

[جمال عبد السميع]

أستخدم أخى هذه المعادلة بدون أى أعمدة مساعدة ستحقق لك المطلوب

{=IF(ISERROR(INDEX('خروج نقديه'!$G$4:$G$129,MATCH(0,COUNTIF($D$3:D3,'خروج نقديه'!$G$4:$G$129)+('خروج نقديه'!$G$4:$G$129=""),0))),IF(ISERROR(INDEX('دخول نقديه'!$G$4:$G$129,MATCH(0,COUNTIF($D$3:D3,'دخول نقديه'!$G$4:$G$129)+('دخول نقديه'!$G$4:$G$129=""),0))),"",INDEX('دخول نقديه'!$G$4:$G$129,MATCH(0,COUNTIF($D$3:D3,'دخول نقديه'!$G$4:$G$129)+('دخول نقديه'!$G$4:$G$129=""),0))),INDEX('خروج نقديه'!$G$4:$G$129,MATCH(0,COUNTIF($D$3:D3,'خروج نقديه'!$G$4:$G$129)+('خروج نقديه'!$G$4:$G$129=""),0)))}

المعادلة معادلة صفيف أى لابد من الضغط على " CTRL+SHIFT+ENTERE"

تقبل تحياتى

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.rar

[ibn_egypt]

محذوفة بمعرفتى للتعديل  

[عادل ابوزيد]

استاذى العزيز والاخ الحبيب جمال عبد السميع

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

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

لى طلب ارجو الا يزعجك هل يمكن ان تكون مرتبه ابجدياً

الموضوع الخاص بشخصكم الكريم على الرابط التالى

http://www.officena.net/ib/index.php?showtopic=45959&hl=%D9%82%D8%A7%D8%A6%D9%85%D8%A9

تم تعديل ديسمبر 2, 2014 بواسطه عادل ابوزيد

[عادل ابوزيد]

الاستاذ الفاضل المحترم

ibn_egypt

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

دمتم فى امان الله

[سليم حاصبيا]

 كود رائع يا بن مصر الرائع

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

Application.screen updating = false

Application.screen updating = true 

Sub copyandremoveblankorduplicate()

Dim ws, ws1, ws2 As Worksheet
Dim lr, lr1, lr2, lrc, lrcr As Long

Set ws = ThisWorkbook.Sheets(1)
Set ws1 = ThisWorkbook.Sheets(2)
Set ws2 = ThisWorkbook.Sheets(3)

lr = ws.Cells(Rows.Count, 3).End(xlUp).Row
lr1 = ws1.Cells(Rows.Count, 7).End(xlUp).Row
lr2 = ws2.Cells(Rows.Count, 7).End(xlUp).Row


ws.Range("C4:C" & lr + 1).ClearContents
ws1.Range("G4:G" & lr1).Copy Destination:=ws.Range("C4")
lrc = ws.Cells(Rows.Count, 3).End(xlUp).Row + 1
ws2.Range("G4:G" & lr2).Copy Destination:=ws.Range("C" & lrc)
Application.CutCopyMode = False

lrcr = ws.Cells(Rows.Count, 3).End(xlUp).Row
Application.ScreenUpdating = False
For x = lrcr To 5 Step -1
        If Application.WorksheetFunction.CountIf(Range("C4:C" & x), Range("C" & x).Text) > 1 Or ws.Range("C" & x).Text = "" Then
            Range("C" & x).EntireRow.Delete
        End If
    Next x
   Application.ScreenUpdating = True
End Sub

انظر الى الكود كيف يصبح و جربه بنفسك و قارن السرعة

عدم المؤاخذهة (لفت نظر مش اكثر)

[ibn_egypt]

الاستاذ الفاضل المحترم

ibn_egypt

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

دمتم فى امان الله

 

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

 

جرب الملف المرفق

 

تحياتي  

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.rar

[عادل ابوزيد]

الاستاذ الفاضل المحترم

عند تنفيذ الكود توقف عن الخطوة التالية

   .Range("C3:C" & LRC2).RemoveDuplicates Columns:=1, Header:=xlNo

ولو تسمح لى يوجد سطر جديد على

     ws2.Range("G4:G" & LR2).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("C4"), Unique:=True

هذا السطر على ما اعتقد هو تصفية متقدمه للعمود g فى ورقة خروج النقدية ولا اين معيار التصفيه وكيف استخلصت الاسماء الغير مكرره فقط

ويوجد سطرين لا اعرف معناهم

     .Range("C3:C" & LRC2).RemoveDuplicates Columns:=1, Header:=xlNo
     .Range("C4", .Range("C" & .Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Delete Shift:=xlUp
 

.. هذا للتعلم .. جزاء الله كل خير

 

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

تم تعديل ديسمبر 2, 2014 بواسطه عادل ابوزيد

[ibn_egypt]

الاستاذ الفاضل المحترم

عند تنفيذ الكود توقف عن الخطوة التالية

   .Range("C3:C" & LRC2).RemoveDuplicates Columns:=1, Header:=xlNo

 

 

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

اخى الفاضل أ.عادل

 

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

 

تحياتي  

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.rar

[عادل ابوزيد]

اسف للازعاج استاذى الفاضل

برجاء قراءة المشاركة رقم 12

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

اقف صامت خجلاً من كثرة الاسئلة ولا يسعنى إلا ان ادعوا لك بخير الدنيا والاخرة ويجنبك شر الدنيا والاخرة

بالكود بعد التعديل2قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.rar

تم تعديل ديسمبر 2, 2014 بواسطه عادل ابوزيد

[ibn_egypt]

اسف للازعاج استاذى الفاضل

برجاء قراءة المشاركة رقم 12

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

اقف صامت خجلاً من كثرة الاسئلة ولا يسعنى إلا ان ادعوا لك بخير الدنيا والاخرة ويجنبك شر الدنيا والاخرة

 

أخى الحبيب أ.عادل

 

الكود ليس به اى مشكلة على الإطلاق واعتقد ان الخطأ ناتج انك تعمل على اصدار اوفيس 2003 وهذا الإصدار لايدعم الدالة Remove Duplicate ... مرفق اخى الحبيب ملف تم تعديل الكود به ليناسب اصدار 2003

 

جرب وابلغنى بالنتيجة

 

تحياتي  

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.rar

[عادل ابوزيد]

استاذى الفاضل المحترم

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

الحل ولله الحمد تمام الفففففففففففففففففف مليييييييييييييييييييييون شكراً

جعله الله فى ميزانك ان شاء الله

السطر التالى ماذا يعنى

            Range("C" & x).Delete xlUp

فهو بدل الغاء الصف كاملاً هل هو يمسح الخلية فقط

تقبل منى كل الحب والشكر والتقدير

[ibn_egypt]

استاذى الفاضل المحترم

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

الحل ولله الحمد تمام الفففففففففففففففففف مليييييييييييييييييييييون شكراً

جعله الله فى ميزانك ان شاء الله

السطر التالى ماذا يعنى

            Range("C" & x).Delete xlUp

فهو بدل الغاء الصف كاملاً هل هو يمسح الخلية فقط

تقبل منى كل الحب والشكر والتقدير

 

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

 

تقبل تحياتى  

[ياسر خليل أبو البراء]

بسم الله ما شاء الله

حلول رائعة من الأخ الحبيب والأستاذ الرائع ابن مصر (أ / إ)

إثراءاً للموضوع تفضل المرفق التالي

 

قائمة بالأسماء الفريدة من أوراق عمل مختلفة.rar

[عادل ابوزيد]

الاستاذ الكبير النشيط ياسر خليل

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

فممكن الشرح

بالاضافه ان الكود يتعامل مع ورق الملف كله  اذا كان الملف فيه ورق كتير ومش عايز غير الورقتين دول اعمل ايه

برجاء اضافة التعديل بعد شرح الكود القديم

تقبل منى كل الشكر والتقدير والامتنان

[ياسر خليل أبو البراء]

الأخ الحبيب عادل أبو زيد إليك في المرفق الملفين معاً.. ملف خاص بكل أوراق العمل .. وملف خاص بورقتي عمل ..

عندك اللي يعجبك اتفضله

Distinct Names From Multi Sheets.rar

تم تعديل ديسمبر 3, 2014 بواسطه YasserKhalil

[عادل ابوزيد]

استاذ استاذ استاذ ياسر خليل

لماذا نسيتنا فى الشرح نريد ان نتعلم منك

جزاك الله كل خير وجعله فى ميزان حسناتك

[ياسر خليل أبو البراء]

أخي الحبيب عادل ابو زيد

إليك شرح ما أعرفه في الكود وما لا أعرفه يتفضل أحد الكبار لشرحه ..

Sub UniqueId()
    'تعريف المتغير v
    Dim v
    'عمل حلقة تكرارية للمصفوفة التي تضم ورقتي العمل المراد العمل عليهما ويمكنك إضافة أوراق أخرى
    For Each v In Array("خروج نقديه", "دخول نقديه")
    'استخدام الجملة التالية With ... End With للتعامل مع كل ورقة عمل على حدا
        With Sheets(v)
            'تحديد قيمة للنطاق المسمى deb بحيث يضم كل الخلايا في هذا النطاق
            Set deb = .Range("G4:G" & .Range("G" & .Rows.Count).End(xlUp).Row)
            'حلقة تكرارية جديدة بداية من الصف الأول في النطاق إلى آخر خلية بالنطاق
            For i = 1 To deb.Rows.Count
                'وضع شرط بحيث يتم تجاوز الخلايا الفارغة ولا يتم التعامل معها
                If deb(i, 1) <> "" Then
                    'عمل مصفوفة لتخزين القيم بها
                    If InStr(raj & ",", "," & deb(i, 1) & ",") = 0 Then raj = raj & "," & deb(i, 1)
                End If
            Next i
        End With
    Next v
    
    roy = Split(Mid(raj, 2), ",")
    'وضع المخرجات أو النتائج في الخلية C4
    Sheets(1).Range("C4").Resize(UBound(roy) + 1) = Application.Transpose(roy)
End Sub

[عادل ابوزيد]

استاذى الفاضل الكبير ياسر خليل

احد عمالقة وكبار منتدى اوفسينا من اعماق قلبى ارسل لك اجمل الكلمات تقديراً وشكراً لكرمك وشرحك الجميل الوافى

ارجو ان تتقبل شكرى وتقديرى

ولا انسى بالطبع استاذى واخى الحبيب جمال عبد السميع

والاستاذ الفاضل الجميل ابن مصر ibn_egypt

لكم منى كل الحب والتقدير والدعاء بالستر والصحة والعافية وصلاح البال ( وليس الحال لانه وقتى )