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

[ابوحمزه المصرى]

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

تم تعديل أبريل 14, 2015 بواسطه salah4444

[ابوحمزه المصرى]

الووووووووووووووووووووووووووووووووو ... أنا مش متعود من المنتدى على كده ... خير ياجماعه

تم تعديل أبريل 15, 2015 بواسطه salah4444

[ابوحمزه المصرى]

[ابوحمزه المصرى]

حد يساعد ياجماعة موضوع الأخ الفاضل ياسر قريب جدا مما اطلبه مع الفارق فى انى اريد البيانات منسقة بتنسق شيت كشف الحساب  انا بحاول بس الموضوع معصلج معى مش عارف المشكله فين اليكم رابط الأخ الفاضل ياسر http://www.officena.net/ib/index.php?showtopic=59889&hl=

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

أخي الحبيب صلاح

أعتذر عن التأخر في الرد ..التمس لي العذر

بالنسبة لطلبك .. مش شرط تكون نفس الطريقة اللي موجودة في التصفية المتقدمة

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

[ابوحمزه المصرى]

لا داعى للاعتذار أخى الفاضل ياسر حمد لله على سلامتك  لعله خير والف مبروك للمره الثالثة على الترقية لمشرف بمنتدانا الرائع  أوفيسنا ... هنا يتم التصفية بناء على أسم العميل .... لكن ممكن استخدم نفس المثال لأضافة اسم المنطقة واسم المحافظة فيما بعد لمثال آخر فلنبدأ بالمثال المرفق وهو يتم التصفية بناء على أسم العميل

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

أخي الفاضل صلاح

جرب الملف التالي ..

Sub Tarhil()
    Dim WS As Worksheet, SH As Worksheet
    Dim strCrt As String
    Dim I As Long, X As Long
    X = 6
    Set WS = Feuil3: Set SH = Feuil4
    strCrt = SH.Range("E2").Value
    Application.ScreenUpdating = False
        SH.Range("D6:S135").ClearContents
        With WS
            For I = 6 To .Cells(Rows.Count, "E").End(xlUp).Row
                If .Cells(I, 5).Value = strCrt Then
                    .Range(.Cells(I, "D"), .Cells(I, "S")).Copy
                    SH.Range("D" & X).PasteSpecial xlPasteValues
                    X = X + 1
                End If
            Next I
        End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

كشف الحساب.rar

[ابوحمزه المصرى]

فى مشكله لما بنعمل فلتر فى اليومية على اسم عميل واختار عميل آخر فى كشف الحساب ما بيرحل هل بيتأثر بالفرز الخاص بشيت اليومية

تم تعديل أبريل 16, 2015 بواسطه salah4444

[ابوحمزه المصرى]

أسف جدا اخى ياسر انا اريد التعديل عليه ليعمل على الشيت جربت كتير ولم يتقبل منى التعديل التالى وفق 3 شروط فى كشف الحساب s1 ,s2 , s3  اكرر اسفى لأنى اثقلت عليك كثيرا الملف المرفق كشف حساب جديد.rar

تم تعديل أبريل 16, 2015 بواسطه salah4444

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

أخي الحبيب لما بتكون الطلبات كثيرة في الموضوع بتوه صراحة ...

 

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

هل جربت الكود في المشاركة رقم 7

هل عمل بنجاح معك أم أن هناك مشكلة ؟ يرجى تحديد الأمر أولاً ..

وإذا كان هناك طلب آخر بشكل مختلف يرجى طرح موضوع جديد ..

[ابوحمزه المصرى]

أخي الحبيب لما بتكون الطلبات كثيرة في الموضوع بتوه صراحة ...

 

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

هل جربت الكود في المشاركة رقم 7

هل عمل بنجاح معك أم أن هناك مشكلة ؟ يرجى تحديد الأمر أولاً ..

وإذا كان هناك طلب آخر بشكل مختلف يرجى طرح موضوع جديد ..

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

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

اطلعت على المرفق الأخير لك ولم أفهم شيء ................!! أيوا والله زي ما بقولك كدا

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

1 - الورقة التي بها البيانات الخام المراد جلب البيانات منها اسمها ايه

2 - الشروط الثلاثة من أي أعمدة ..

3- أعتقد أنه ربما يكون هناك مشكلة في الشرط الأول "منطقة_القاهرة_أمكو2" حيث أن هذا الشرط غير موجود في ورقة العمل RawData

4- وضح بالتفصيـــــــــــــــــــــــــــل ..

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

بعدما تختار اسم العميل اضغط الأمر Run ليتم التنفيذ ...

أمر آخر اختيار اسم العميل بيكون من ورقة العمل "كشف الحساب" وليس اليومية ..

شوف الأول الكود شغال تمام أو لا

[ابوحمزه المصرى]

s1 , s2 , s3 هم قوائم منسدله ستجد بهم الاختيار الموجود فى اليومية اخى الفاضل ياسر

[ابوحمزه المصرى]

انا بالفعل بضغط الأمر RUN لكن لو انك قمت بعمل فلتر فى اليومية لأسم العميل بن سينا مثلا ثم اخترت بهلول من كشف الحساب ثم الضغط RUN فلم يرحل اى بيانات

تم تعديل أبريل 16, 2015 بواسطه salah4444

[ابوحمزه المصرى]

 فى المثال التالى شرح المطلوب كما طلبت اعتذر إن كنت اثقلت عليك أخى الكريم كشف حساب جديد.rar

تم تعديل أبريل 16, 2015 بواسطه salah4444

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

سؤال أخير ..الشغل هيكون على أي مرفق الآن .. لأن في الموضوع الآن مرفقين مختلفين !!!!

[ابوحمزه المصرى]

الأخير المشاركه رقم 16 أخى الكريم ابو البراء

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

جرب المرفق التالي ..

 

كشف حساب جديد.rar

[ابوحمزه المصرى]

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

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

جربت وعملت فلتر وتم الترحيل بشكل عادي

.. المرفق الأخير الذي تم العمل عليه مفيهوش ورقة عمل باسم اليومية .. جربت على ورقة العمل RawData

خليك دقيق بالله عليك

تقبل تحياتي

[ابوحمزه المصرى]

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

تم تعديل أبريل 16, 2015 بواسطه salah4444

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

هل تم المطلوب بحمد الله ؟

هل انتهت مشكلتك في عملية الترحيل عند عملية الفرز؟

إذا كانت المشكلة قد انتهت فيرجى الالتزام بالتوجيهات واختيار أفضل إجابة ليظهر الموضوع مجاب

[ابوحمزه المصرى]

آخر طلب من الأخ الكريم ياسر ممكن شرح الكود اسأل الله أن تستقبل السؤال بصدر رحب

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

يا رب يكون آخر طلب أخي صلاح ..

بهزر معاك طبعاً ..اطلب براحتك بس يا ريت ميكونش كله في موضوع واحد !

Sub Tarhil()
'تعريف المتغيرات
    Dim WS As Worksheet, SH As Worksheet
    Dim strCrt As String
    Dim I As Long, X As Long
'بحيث يساوي رقم 6 وهذا الرقم يمثل أول صف سيتم الترحيل إليه [X] تعيين قيمة للمتغير
    X = 6
'تعيين أوراق العمل : ورقة العمل المراد الترحيل منها وورقة العمل المراد الترحيل إليها
    Set WS = RawData: Set SH = ClientSheet
'في ورقة العمل المسماة كشف حساب العميل [T1] وهو الشرط المراد العمل على أساسه في عملية الترحيل ، وقد تم دمج الشروط في خلية واحدة فقط وهي الخلية [strCrt] تعيين قيمة للمتغير
    strCrt = SH.Range("T1").Value
'الغاء خاصية اهتزاز الشاشة لتسريع عمل الكود
    Application.ScreenUpdating = False
'مسح محتويات النطاق المراد الترحيل إليه
        SH.Range("A6:R135").ClearContents
'[RawData]بدء التعامل مع ورقة العمل المسماة
        With WS
'حلقة تكرارية من الصف رقم 6 إلى آخر خلية بها بيانات في ورقة العمل المراد الترحيل منها
            For I = 6 To .Cells(4000, 1).End(xlUp).Row
' تساوي الشرط أم لا [S] جملة شرطية لمعرفة إذا ما كانت الخلية الموجودة في الصف في العمود
                If .Cells(I, "S").Value = strCrt Then
'[R] إلى العمود [A] إذا تحقق الشرط يقوم هذا السطر بنسخ السطر بداية من العمود
                    .Range(.Cells(I, "A"), .Cells(I, "R")).Copy
'كبداية عملية اللصق [A6] لصق الصف الذي تم نسخه كقيم فقط إلى الخلية
                    SH.Range("A" & X).PasteSpecial xlPasteValues
'زيادة قيمة المتغير بمقدار واحد استعداداً للصق صف جديد إذا تحقق الشرط
                    X = X + 1
'نهاية الشرط
                End If
'الانتقال إلى صف جديد في الحلقة التكرارية
            Next I
'إنهاء التعامل مع ورقة العمل المراد الترحيل منها
        End With
'الغاء خاصية النسخ والقص
    Application.CutCopyMode = False
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي