السلام عليكم - يوجد ملف في الفيس غير قادر على تحميله الناشر الاخ ياسر

[عبدالرحمن حارثة]

السلام عليكم - حاولت ان احمله ولكن لم أتمكن ونصح الأخ ياسر أن ازور منتدى اوفيسنا

نع العلم أن لي من الأصدقاء يترحمون على هذا المنتدى لما يقدمه من حلول ساعد الكثير من الناس لحل مشاكهم في العمل

https://www.file-upload.com/1tno7fg704kk

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

وعليكم السلام أخي الكريم حارثة

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

 

ها هو الملف الذي لم تستطع تحميله .. وأرجو أن يفيدك إن شاء الله

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

وتقبل تحياتي

Transfer To Related Sheet Using Arrays And Check Worksheet Exists UDF YasserKhalil Facebook.rar

[عبدالرحمن حارثة]

اهلاً ومرحبا اخي ياسر - مشكور على الترحيب

تأتينا قوائم (اكسل)  بين فترة وأخرى تحتوي على المعلومات المبينة بالمثال ادناه

الطلب هو : أن يكون شيت (ورقة) حسب رمز المادة ، وكل ما تأتينا قائمة نحن نجمع كل مادة في شيت 

Transfer To Related Sheet Using Arrays And Check Worksheet Exists UDF YasserKhalil Facebook.rar

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

هل سيكون لكل رمز صف واحد فقط من البيانات

الأفضل إرفاق ملف فيه 15 أو 20 صف ليكون معبر عن الملف الأصلي

إذا كان الطلب لصف واحد فالأمر سيكون بسيط في تعديل الكود الموجود بالملف أما خلاف ذلك فسيلزم كود آخر

[عبدالرحمن حارثة]

مشكور أستاذ على الاهتمام

لبيان المطلوب تم التعديل على الملف 

فمثلا : في يوم 10/7/2017 جاءت قائمة تحتوي على بيع لاب توب بعدد 2  وتم ادراج المادة في الشيت المخصص

ويوم 12/7/2017  جاءت قائمة تحتوي على نفس المادة بعدد 1  هنا يتم درج المادة اسفلها وهكذا كلما جاءت قائمة جديدة لنفس المادة تدرج اسفلها

مع العلم بان قائمة تحتوي على الأقل (25) مادة مختلفة او متشابهة حسب البيع

وهكذا في نهاية الشهر يطلب منا طبع القوائم حسب الصنف 

2.rar

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

أعتذر إليك فقد حدث لبس في فهم المطلوب لدي .. هل المطلوب نفس عمل الكود الأصلي وهو الترحيل من الورقة الرئيسية إلى بقية أوراق العمل .؟ أم من أوراق العمل إلى الورقة الرئيسية ..؟

الملف المرفق ليس به بيانات كافية .. ارفق 10 أو 15 سطر لتوضيح الأمر كما ينبغي والتأكيد على إجابة السؤال لبدء العمل إن شاء الله

[عبدالرحمن حارثة]

الترحيل من القوائم الى الشيتات المخصصة لكل مادة حسب الرمز

وتم التعديل على الملف لتوضيح المطلوب 

واعتذر على الالتباس الذي سببته لكم

جزيت خيرا

2.rar

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

تمام .. بس في الملف المرفق اسم ورقة العمل 7 .. ومرحل إليها الكود رقم 25 ..!؟

وسؤال أخير : ماذا عن الأكواد التي ليس لها أوراق عمل موجودة بالمصنف ... مثال : الكود 61 ليس له ورقة عمل موجودة فما العمل في هذه الحالة؟

وإن شاء الله أحاول في موضوعك غدأ لأن الوقت قد تأخر والعين قد غالبها النوووووووووم

[عبدالرحمن حارثة]

نوم العافية وتصبح على خير ان شاء الله

لكل كود شيت مخصص حسب رقم الكود 

اختارت مثال فقط للتوضيح - صحيح المفروض رقم الشيت يكون حسب رقم الكود (أخطأت بالنسبة الى الكود (7) المفروض يكون 25 )

السلام عليكم

 

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

منذ ساعه, حارثة ابو زيد said:

نوم العافية وتصبح على خير ان شاء الله

لكل كود شيت مخصص حسب رقم الكود 

اختارت مثال فقط للتوضيح - صحيح المفروض رقم الشيت يكون حسب رقم الكود (أخطأت بالنسبة الى الكود (7) المفروض يكون 25 )

السلام عليكم

 

وسؤال أخير : ماذا عن الأكواد التي ليس لها أوراق عمل موجودة بالمصنف ... مثال : الكود 61 ليس له ورقة عمل موجودة فما العمل في هذه الحالة؟

[عبدالرحمن حارثة]

السلام عليكم

ملف لبيان المطلوب ، واعتذر عدم ايصالي الطلب من أول مشاركة

تعبتك أستاذ 

 

3.rar

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

وعليكم السلام أخي حارثة

تصدق إنك بردو مجاوبتنيش على سؤالي .. عموماً جهزت لك ملف وإن شاء الله يكون المطلوب

أعتذر لتحميل الملف على موقع خارجي .. نظراً لأن الملف اجتهاد شخصي وأخذ من وقتي أكثر من ساعة ونصف

تحميل الملف من هنا

[عبدالرحمن حارثة]

جاري تحميل الملف وحسب الخطوات وظهور الرسالات التالية

لم استطع تحميل الملفات 

[عبدالرحمن حارثة]

لا استطيع تحميل الملف من الساعة 3 ظهر  باشرت ولم استطيع تحميل الملف 

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

 

توجد طريقة اخرى

 

تم تعديل يوليو 13, 2017 بواسطه حارثة ابو زيد

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

أعتذر أخي الكريم حارثة عن المعاناة التي عانيتها .. عموماً تفضل الملف المرفق (ولكن إذا أردت دعمي حاول التحميل من الموقع لأنه يعطيني ربح على التحميلات .. كل ألف تحميل بـ 4 دولار تقريباً)

المهم إليك الملف المرفق ..

 

Transfer Data From Main Sheet To Related Sheets Using Dictionary YasserKhalil Officena.rar

[عبدالرحمن حارثة]

اشكرك استاذ ياسر  - جزيت خيرا

تم تحميل الملف وتم الترحيل 

وهو المطلوب

وان شاء الله اتابع تحميل الملفات التي احتاجها من الموقع - جزاك الله خيرا - وأني اعتذر منك على التعب - وان شاء الله يغنيك ويعافيك ويبارك لك في وقتك

اطلعت على شروط المنتدى حول الاسئلة - ولكن اعتقد ان سؤالي ادناه في صلب الموضوع

لأن حالاً افتهمت ما تريد مني عندما سألتي  (  وسؤال أخير : ماذا عن الأكواد التي ليس لها أوراق عمل موجودة بالمصنف ... مثال : الكود 61 ليس له ورقة عمل موجودة فما العمل في هذه الحالة؟ ) وهو سؤال مهم جدا ) 

فاعتذر على عدم فهمي للسؤال

ممكن اذا ما موجودة ورقة العمل انشائها تلقائيا

 

 

 

تم تعديل يوليو 13, 2017 بواسطه حارثة ابو زيد

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

بارك الله فيك أخي الكريم حارثة

نعم يمكن إضافة أسطر للكود لإنشاء أوراق عمل في حالة عدم وجودها ، ولكن أفضل أن يكون هناك ورقة Template كنموذج يتم نسخها ووضع النتائج بها ..

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

[عبدالرحمن حارثة]

نعم استاذ ياسر - موضوع مهم ويسهل العمل بسبب كثرة عدد المواد 

تسلم 

واشكرك

ويدفع الله عنك كل شر وبلاء

[عبدالرحمن حارثة]

السلام عليكم -  عزيزي استاذ ياسر - اعتذر منك لضيق وقتك 

تم جلب قوائم (اكسل) فعندما ندخلها في شيت القوائم ونرحلها -  يحذف القديم ويحل محالها الترحيل الاخير

والمطلوب هو الترحيل اسفلها ويبقى القديم 

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

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

وعليكم السلام أخي الكريم حارثة

تفضل الكود بعد التعديل .. التعديل بسيط في إضافة سطر قرب نهاية الكود وتعديل السطر الذي يليه (وعشان متعبكش ..إليك الكود بالكامل)

Option Explicit

Sub TransferToRelatedSheets()
    Dim wks         As Worksheet
    Dim data        As Variant
    Dim item        As Variant
    Dim key         As Variant
    Dim dict        As Object
    Dim rng         As Range
    Dim rngBeg      As Range
    Dim rngEnd      As Range
    Dim cell        As Range
    Dim x           As Long
    Dim y           As Long
    Dim lr          As Long
    
    Set wks = ThisWorkbook.Worksheets("القوائم")
    Set rngBeg = wks.Range("A2:H2")

    Set rngEnd = wks.Cells(Rows.Count, rngBeg.Column).End(xlUp)
    If rngEnd.Row < rngBeg.Row Then Exit Sub
    Set rng = wks.Range(rngBeg, rngEnd)
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare

    Application.ScreenUpdating = False
        For Each cell In rng.Columns(1).Cells
            key = Trim(cell)
            item = cell.Resize(1, rng.Columns.Count).Value
            item(1, 6) = CLng(item(1, 6))
            
            If Not dict.Exists(key) Then
                dict.Add key, item
            Else
                data = Application.Transpose(dict(key))
                x = UBound(data, 1)
                y = UBound(data, 2) + 1
                ReDim Preserve data(1 To x, 1 To y)
    
                data = Application.Transpose(data)
    
                For x = 1 To UBound(item, 2)
                    data(y, x) = item(1, x)
                Next x
    
                dict(key) = data
            End If
        Next cell
    
        For Each item In dict.Items
            If WorksheetExists(CStr(item(1, 1))) Then
                x = UBound(item, 1)
                y = UBound(item, 2)
                lr = Worksheets(CStr(item(1, 1))).Cells(Rows.Count, 1).End(xlUp).Row + 1
                Set rng = Worksheets(CStr(item(1, 1))).Range("A" & lr)
                rng.Resize(x, y).Value = item
            End If
        Next item
    Application.ScreenUpdating = True
    
    MsgBox "Done...", 64
End Sub

Function WorksheetExists(sheetName As String) As Boolean
    Dim sheet       As Worksheet
    Dim temp        As String

    temp = UCase(sheetName)
    WorksheetExists = False

    For Each sheet In Worksheets
        If temp = UCase(sheet.Name) Then
            WorksheetExists = True
            Exit Function
        End If
    Next sheet
End Function

 

[عبدالرحمن حارثة]

1000 %  احسنت - جزيت خيرا

اشكرك

واشكر سعة صدرك وتحملك وياي لكثرة طلباتي

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

 

تم تعديل يوليو 14, 2017 بواسطه حارثة ابو زيد

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

الحمد لله الذي بنعمته تتم الصالحات ..

تقبل تحياتي

[عبدالرحمن حارثة]

السلام عليكم - مرحبا استاذ

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

 

تم تعديل يوليو 15, 2017 بواسطه حارثة ابو زيد

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

وعليكم السلام

بص يا أخي حارثة أبو زيد (أبو عبد الواجد) ..

لو البيانات اللي عندك فيها تواريخ شوف رقم العمود للتاريخ وليكن رقم 6 واترك السطر ده لأنه مهم

لو مفيش تواريخ شيل السطر ده وبس خلاص إن شاء الله تتحل المشكلة

[عبدالرحمن حارثة]

السلام عليكم - جزيت خيرا 

من حارثة الى أستاذ ياسر - اشكرك 

الكود يعمل في حالة رفع بيانات عمود التاريخ

تمام 1000 %

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

لو البيانات اللي عندك فيها تواريخ شوف رقم العمود للتاريخ وليكن رقم 6 واترك السطر ده لأنه مهم

لو مفيش تواريخ شيل السطر ده وبس خلاص إن شاء الله تتحل المشكلة

 

 

تم تعديل يوليو 16, 2017 بواسطه حارثة ابو زيد