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

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

قام بنشر (معدل)

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

تم تعديل بواسطه 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

قام بنشر (معدل)

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

تم تعديل بواسطه salah4444
قام بنشر (معدل)

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

تم تعديل بواسطه salah4444
قام بنشر

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

 

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

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

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

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

قام بنشر

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

 

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

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

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

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

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

قام بنشر

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

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

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

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

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

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

قام بنشر

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

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

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

قام بنشر (معدل)

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

تم تعديل بواسطه salah4444
قام بنشر (معدل)

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

تم تعديل بواسطه salah4444
قام بنشر

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

قام بنشر

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

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

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

تقبل تحياتي

قام بنشر (معدل)

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

تم تعديل بواسطه 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


تقبل تحياتي

  • Like 2

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