اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

 

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

 

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

 

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

 

تحياتي  :fff: 

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.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

رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

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

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

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

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

 

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

 

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

 

تحياتي :fff: 

قائمة واحدة من الاسماء بعد دمج اسماء موجوده بعمودين فى شيتين.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
 

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

 

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

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

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

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

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

 

 

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

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

 

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

 

تحياتي :fff: 

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

رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

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

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

 

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

 

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

 

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

 

تحياتي :fff: 

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

رابط هذا التعليق
شارك

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

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

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

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

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

            Range("C" & x).Delete xlUp

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

            Range("C" & x).Delete xlUp

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

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

 

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

 

تقبل تحياتى :fff: 

رابط هذا التعليق
شارك

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

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

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

 

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

رابط هذا التعليق
شارك

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

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

فممكن الشرح

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

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

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

رابط هذا التعليق
شارك

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

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

Distinct Names From Multi Sheets.rar

تم تعديل بواسطه YasserKhalil
  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

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



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information