اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

تجميع البيانات في صفحة واحده


Abo Eslam

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

السلام عليكم ورحمه الله .

يوجد لدي جرد في اكثر من صفحة وعندي مثلا بند " مكتب ايديال 3 درج " في اكثر من صفحة اريد تجميع الموجود من الجرد في العمود G لكل صنف في كل الصفحات وعمل صفحة بها كل البنود التي بالعمود D  . اريد جدول من عمودين الاول اسماء الاصناف والثاني الموجود في واقع الجرد لكل صفحات الملف المرفق 

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

أخي الكريم أبو إسلام

أهلاً ومرحباً بك في المنتدى ونورت بين إخوانك

 

يرجى الإطلاع على رابط التوجيهات في الموضوعات المثبتة في المنتدى لمعرفة كيفية التعامل مع المنتدى

كما يرجى تغيير اسم الظهور للغة العربية لسهولة التواصل

 

إليك الكود التالي لعله يفي بالغرض

Sub UniqueListFromMultipleSheets()
    Dim X, Y(), I&, J&, K&, WS As Worksheet
    ReDim Y(1 To Rows.Count, 1 To 2)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each WS In ThisWorkbook.Worksheets(Array("1", "2", "3"))
            X = WS.Range("D10:G" & WS.Cells(Rows.Count, 4).End(xlUp).Row).Value
            For I = 2 To UBound(X)
                If Len(X(I, 1)) Then
                    If .Exists(X(I, 1)) Then
                        K = .Item(X(I, 1))
                        Y(K, 2) = Y(K, 2) + X(I, 4)
                    Else
                        J = J + 1
                        .Item(X(I, 1)) = J
                        Y(J, 1) = X(I, 1)
                        Y(J, 2) = X(I, 4)
                    End If
                End If
            Next I
        Next WS
    End With

    With Sheets("Final")
        .UsedRange.ClearContents
        .Range("A1:B1") = Array("اسم الصنف", "الموجود من واقع الجرد")
        .Range("A2").Resize(J, 2).Value = Y()
    End With
End Sub


لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

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

 

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

Extract Unique Values From Multiple Sheets YasserKhalil.rar

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

شكرا استاذنا الكبير ياسر خليل علي اهتمامكم . وعلي هذا الملف الرائع ولكن استاذي هذا الملف ادي الغرض لثلاث صفحات فقط هي 1 , 2 و 3 ولاكن ملفي به عدد 120 صفحة اريد تطبيق هذا الكود علي ملف به عدد كبير من الصفحات علما بان عدد الاسطر في كل صفحة يزيد علي 30 سطر .

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

لم تنوه في المشاركة الأولى عن ذلك الأمر

ولذا أنا دائماً أؤكد على التوضيح التام للطلب حتى لا يطول الموضوع بدون داعي

إليك الكود التالي جربه مع ملفك الأصلي وشوف النتائج صحيحة أم لا ...

إذا كان هناك أوراق عمل أخرى غير 120 وجب التعديل في الكود في السطر التالي

If WS.Name <> "Final" Then

ستضيف أسماء أوراق العمل المراد استثناءها من تنفيذ الكود ...

Sub UniqueListFromMultipleSheets()
    Dim X, Y(), I&, J&, K&, WS As Worksheet
    ReDim Y(1 To Rows.Count, 1 To 2)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each WS In ThisWorkbook.Worksheets
            If WS.Name <> "Final" Then
                X = WS.Range("D10:G" & WS.Cells(Rows.Count, 4).End(xlUp).Row).Value
                For I = 2 To UBound(X)
                    If Len(X(I, 1)) Then
                        If .Exists(X(I, 1)) Then
                            K = .Item(X(I, 1))
                            Y(K, 2) = Y(K, 2) + X(I, 4)
                        Else
                            J = J + 1
                            .Item(X(I, 1)) = J
                            Y(J, 1) = X(I, 1)
                            Y(J, 2) = X(I, 4)
                        End If
                    End If
                Next I
            End If
        Next WS
    End With

    With Sheets("Final")
        .UsedRange.ClearContents
        .Range("A1:B1") = Array("اسم الصنف", "الموجود من واقع الجرد")
        .Range("A2").Resize(J, 2).Value = Y()
    End With
End Sub


لا تنسى أن تنهي الموضوع بتحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

تقبل تحياتي

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

يظهر هذا الخطأ استاذي عند تغير محتوي خلايا العمود D الي #N/A  مرفق نفس المثال بعد تعديل خلية D15 في الصفحة رقم 3 وعندها لا يعمل الكود . ارجو تعديل Extract Unique Values From Multiple Sheets YasserKhalil.xlsm الكود بحيث يتلاشي عند القراءة اي error في العمود D

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

أخي الكريم

يوجد في الخلية D15

في ورقة العمل رقم 3 خطأ

وكيف يكون لاسم صنف خطأ عدد مقابل له في عمود الموجود من الجرد

قم بإرفاق الملف الأصلي لأنه يبدو أنك لم تضع نموذج معبر عن المشكلة من البداية ..

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

قم بضبط المعادلة VLOOKUP

وذلك بإضافة الدالة

IFERROR

قبل اسم الدالة وفي نهاية المعادلة فاصلة ثم أقواس تنصيص مرتين ثم أغلق القوس

لتكون المعادلة بهذا الشكل

=IFERROR(VLOOKUP(C11,'C:\Users\Mariam\Desktop\New folder\[find.xls]اكواد الاصناف'!$A$1:$IV$65536,3,0),"")

المعادلة كمثال فقط للتطبيق عليها

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information