اذهب الي المحتوي
أوفيسنا

عمل تقرير وفلترة بعدة شروط


moaaz2020
إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

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

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

احاول عمل ملف لتنظيم صرفيات العمال في المشاريع  ولكنني واجهت صعوبه في عمل بحث او فلتره للبيانات الموجودة في الملف Payments لخيار واحد او عدة خيارات مع بعض

مثلا البحث وفق اسم المستلم او المشروع او المستلم والمشروع مع بعض كما هو موجود في الملف المرفق

ولاحظت ان الملف ثقيل مع انه لايحتوي على داتا كثيره ولا يوجد فيه اي ماكرو 

واي شخص لديه اضافه يمكن ان يساعدني بها في الملف فليتفضل

تحياتي

حسابات المشاريع.xlsx

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

Payments!$B$1:$B$65536  كيف تريد ان لا يكون الملف ثقيلاُ وانت تستعمل في 6 صفجات في كل منها  حوالي 100 معادلة وكل معادلة تبحث في 65536 صف اي ما مجموعه  65556×100×6 = اكثر من 40 مليون معادلة (مضروبة بــ 2 لأن البرنامج يعطي نتيجتين لكل معادلة أو الجواب صجيجاً او فراغ اذا كانت النتيجة خطأ) و هكذا الاكسل يقوم بأكثر من 80 مليون عملية حسابية مع كل ضغطة زر من الكيبورد او نقرة من الماوس 

كل هذا بالاضافة الى التنسيقات التي تقوم لها من تلوين بألوان مختلفة يزيد من ثقل الملف على الرغم من قلة البيانات فيه

(الاكسل معذور في هذه الحالة)

خفف المعادلات من حيث عدد الصفوف (اجعلها مثلاُ 1500 بدل 65536)

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

كثير منا تنقصه الخبره ويقوم بنقل الصفحات والمعادلات من ملفات جاهوه فقط ولذلك يقع في هذا الخطا ...

شكرا  لك لتنبيهي لاهميه هذا الامر وساحاول تعديله باذن الله

تحياتي لك

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

  • أفضل إجابة

كاسم المستلم مثلا او المستلم + المشروع معا

لم أر  المستلم ولا المشروع في الجدول 

فهل المستلم هو المستفيد   والمشروع هو الموقع   ام بالعكس 

جرب هذا الملف (صفحة One For_All ) الملف مرفق 

Option Explicit

Dim DC As Object
Dim DD As Object
Dim D_Sh As Object
Dim O As Worksheet
Dim sh As Worksheet
Dim i, Max_ro%, m%
'++++++++++++++++++++++++++++++
Private Sub Worksheet_Activate()
data_val
End Sub
'++++++++++++++++++++++++++
Sub MY_choose()
Select Case Sheets("One For_All").Range("G2")
 Case "E": Filter_Only_E
 Case "D": Filter_Only_D
 Case "D+E": Filter_C_And_D
 Case Else: Exit Sub
End Select
End Sub

'++++++++++++++++++++
Sub data_val()

Set O = Sheets("One For_All")
Set DC = CreateObject("Scripting.Dictionary")
Set DD = CreateObject("Scripting.Dictionary")

Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row
For i = 2 To Max_ro
  DC(Sheets("Payments").Cells(i, "C").Value) = vbNullString
  DD(Sheets("Payments").Cells(i, "D").Value) = vbNullString
 Next
With O.Range("D2").Validation
 .Delete
 .Add 3, Formula1:=Join(DC.keys, ",")
End With
With O.Range("E2").Validation
 .Delete
 .Add 3, Formula1:=Join(DD.keys, ",")
End With
End Sub
'+++++++++++++++++++++++++++
Sub Filter_Only_E()
Set O = Sheets("One For_All")
If O.Range("C4").CurrentRegion.Rows.Count > 1 Then
  O.Range("C4").CurrentRegion.Offset(1). _
  Resize(O.Range("C4").CurrentRegion. _
  Rows.Count - 1).Clear
End If
Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row
m = 5
If O.Range("E2") = vbNullString Then Exit Sub
For i = 2 To Max_ro
 If Sheets("Payments").Cells(i, "D") = O.Range("E2") Then
  O.Cells(m, 3) = m - 4
  O.Cells(m, 4).Resize(, 5).Value = _
  Sheets("Payments").Cells(i, 2).Resize(, 5).Value
  m = m + 1
 End If
Next
If O.Range("C4").CurrentRegion.Rows.Count > 1 Then

 With O.Range("C4").CurrentRegion.Offset(1). _
   Resize(O.Range("C4").CurrentRegion.Rows.Count - 1)
     
  .Borders.LineStyle = 1
  .Font.Size = 14
  .Font.Bold = True
  .Interior.ColorIndex = 35
  .InsertIndent 1
  End With
  End If
End Sub
'+++++++++++++++++++++++++++++++++++
Sub Filter_Only_D()
Set O = Sheets("One For_All")
If O.Range("C4").CurrentRegion.Rows.Count > 1 Then
  O.Range("C4").CurrentRegion.Offset(1). _
  Resize(O.Range("C4").CurrentRegion. _
  Rows.Count - 1).Clear
End If
Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row
m = 5
If O.Range("D2") = vbNullString Then Exit Sub
For i = 2 To Max_ro
 If Sheets("Payments").Cells(i, "C") = O.Range("D2") Then
  O.Cells(m, 3) = m - 4
  O.Cells(m, 4).Resize(, 5).Value = _
  Sheets("Payments").Cells(i, 2).Resize(, 5).Value
  m = m + 1
 End If
Next
If O.Range("C4").CurrentRegion.Rows.Count > 1 Then

 With O.Range("C4").CurrentRegion.Offset(1). _
   Resize(O.Range("C4").CurrentRegion.Rows.Count - 1)
     
  .Borders.LineStyle = 1
  .Font.Size = 14
  .Font.Bold = True
  .Interior.ColorIndex = 35
  .InsertIndent 1
  End With
  End If
End Sub
'++++++++++++++++++++
Sub Filter_C_And_D()
Set O = Sheets("One For_All")
If O.Range("C4").CurrentRegion.Rows.Count > 1 Then
  O.Range("C4").CurrentRegion.Offset(1). _
  Resize(O.Range("C4").CurrentRegion. _
  Rows.Count - 1).Clear
End If
Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row
m = 5
If O.Range("D2") = vbNullString Or _
  O.Range("E2") = vbNullString Then Exit Sub
For i = 2 To Max_ro
 If Sheets("Payments").Cells(i, "C") = O.Range("D2") And _
    Sheets("Payments").Cells(i, "D") = O.Range("E2") Then
  O.Cells(m, 3) = m - 4
  O.Cells(m, 4).Resize(, 5).Value = _
  Sheets("Payments").Cells(i, 2).Resize(, 5).Value
  m = m + 1
 End If
Next
If O.Range("C4").CurrentRegion.Rows.Count > 1 Then

 With O.Range("C4").CurrentRegion.Offset(1). _
   Resize(O.Range("C4").CurrentRegion.Rows.Count - 1)
     
  .Borders.LineStyle = 1
  .Font.Size = 14
  .Font.Bold = True
  .Interior.ColorIndex = 35
  .InsertIndent 1
  End With
  End If
End Sub

 

Hisabat_Super.xlsm

  • Like 1
  • Thanks 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