إخفاء الصفوف والأعمدة الزائدة

[khaled shemey]

شيت خاص بالجمعية الشهرية بين الافراد

                               ارجو مساعدتي في اخفاء الأعمدة والصفوف الزائدة

                                                             في شيت حساب الجمعية بناءاً علي عدد الأفراد في شيت المعلومات الأولية

                                                                                                           ولكم جزيل الشكر

جمعية-شهرية.xlsx

[جمعة العوامي]

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

شوف الصفحة الثالثة .. في الجدول المرفق .. 

او اعمل لك جدول مشابه للذي طلبته .. بناءاً على مافهمته انا من المعلومات الاولية ...

جمعية-شهرية _ تعديل طفيف.xlsx

تم تعديل فبراير 21, 2019 بواسطه جمعة العوامي

[khaled shemey]

شكرا جزيلا اخي جمعة العوامي علي سرعة الرد

الذي اطلبة عند تحديد عدد الأفراد في شيت المعلومات الأولية c2 يتم تجديد عدد الصفوف والاعمدة واخفاء باقي الصفوف من شيت حساب الجمعية

[جمعة العوامي]

الشكر لله اولا .. ثانيا .. جمعة العوامي .. هو اسم ابني الشهيد باذن الله .. 

وعملت لك جدول ثاني .. ان شاء الله يكون هو المطلوب .. 

واي خدمة تانية .. اهلا بك في اي وقت ..

.. الشكر لله ولاعضاء واساتذة هذا الموقع التعليمي .. جزاهم الله عنا كل خير .. وفي ميزان حسناتهم ..

 

جمعية-شهرية _ تعديل طفيف2.xlsm

[سليم حاصبيا]

 بعد اذن الأخ أبي الِشهيد بإذن الله جمعة

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

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

Private Sub CommandButton1_Click()
Dim ws As Worksheet, wss As Worksheet
Dim lrr%, i%
Dim My_row%
Dim row_n%
Set ws = Sheets("معلومات أولية")
Set wss = Sheets("حساب الجمعية2")
Dim s_range As Range
no1 = ws.Range("c2")
wss.Rows.Hidden = False
On Error Resume Next
Set s_range = wss.Range("B:B").Find(no1, lookat:=xlWhole)
My_row = s_range.Row
On Error GoTo 0
If My_row = 0 Then Exit Sub
     row_n = My_row: Rows(row_n).Hidden = True
  Do
    Set s_range = wss.Range("B:B").FindNext(s_range)
     My_row = s_range.Row
     If My_row = row_n Then Exit Do
     Rows(My_row).Hidden = True
 Loop

End Sub

 

[khaled shemey]

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

كما اتقدم بالشكر للأستاذ سليم حاصبيا علي سرعة الرد 

[جمعة العوامي]

استاذ سليم حاصبيا ..بارك الله فيك .. ومشكور ع سرعة الرد ...

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

 

لاشكر على واجب استاذ khaled shemey فنحن نتعلم ... والدنيا افادة واستفادة .. وفي ميزان حسنات من علمني حرفا 

او اخذت منه اي معلومة .. المهم العمل الصالح والدعاء المستجاب باذن الله ... 

[سليم حاصبيا]

سأعمل على هذا ان شاء الله بعد الانتهاء من العمل

من فضلك أرفع الملف ثانية لاني قد مسحته من جهازي

[جمعة العوامي]

تفضل استاذ سليم ... مع جزيل الشكر والامتنان لرحابة الصدر .. 

جمعية-شهرية _ تعديل طفيف3.xlsm

[سليم حاصبيا]

منذ ساعه, جمعة العوامي said:

تفضل استاذ سليم ... مع جزيل الشكر والامتنان لرحابة الصدر .. 

جمعية-شهرية _ تعديل طفيف3.xlsm

تم عمل المطلوب 

الكود

Option Explicit
Sub filter_for_ME()
    With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
    End With
Dim t_sh As Worksheet: Set t_sh = Sheets("حساب الجمعية4")
Dim s_sh As Worksheet: Set s_sh = Sheets("معلومات أولية")
Dim My_Table As Range: Set My_Table = t_sh.Range("A10").CurrentRegion

t_sh.Range("Bn2").Formula = "=B11>='معلومات أولية'!$C$2"

My_Table.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=t_sh.Range("BN1:BN2")
t_sh.Range("BN2").ClearContents
    With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
    End With
End Sub
'======================================
Sub show_All()
On Error Resume Next
Sheets("حساب الجمعية4").ShowAllData
On Error GoTo 0
End Sub

الملف مرفق

 

Ta3dil.xlsm

[جمعة العوامي]

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

طباعة كشف 

تقبلوا فائق التحيات والاكرام ..