سليم حاصبيا

انسخ واحدة من المعادلات الى الخلية B3 ,واسحب تزولاً (استعمل الفاصلة المنقوطة او الفاصلة قي المعادلة - حسب اعدادات الجهاز عندك) =IF($C3="","",SUBTOTAL(103,$C$3:C3)) أو =IF($C3="";"";SUBTOTAL(103;$C$3:C3))

في المشاركة التي كتبتها كانت الاعمدة متشابهة تماماً (كل الصفوف في كل عامود متساوية) و انا اخذت على هذا الاساس اذا لا كنت تريد ذلك ارفع النموذج المطلوب

لو امكن ان ترفع جزء من الملف حوالي 20 صف غي كل صفحة لمعرفة كيفية التعامل مع الملف حيث اني اري معادلات لا تعمل كما يجب و حدد ماذا تريد ان ترقم في العامود A هل 1 2 أو الرقم 1 الرقم 2 لان الفلتر يتأثر بهذا

بعد اذن اخي زيزو بدون حلقات تكرارية هذا الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.ScreenUpdating = False On Error GoTo exit_sub If Target.Column <> 2 And Target.Cells.Count > 1 Then GoTo exit_sub Sheets(Target.Value & "").Activate exit_sub: Err.Number = 0 Application.ScreenUpdating = True End Sub

استبدل الفاصلة "," بفاصلة منقوطة ";" قي المعادلة أو العكس(حسب اعدادات الجهاز عندك) لتصبح هكذا =MOD($A1,4)=0 أو =MOD($A1;4)=0

ؤقض الجهاز التعامل مع ملقك لقد عملت لك ملفاً بديلاً (بشبه ما عتدك) اي تفيير في قيمة الخلية B2 ينفذ الكود مباشرة و هناك زر لاظهار الصفوف اذا كانت قيمة الخلية B2 غير موجودة قي العامود الاول يتم اظهار كل الصفوف Show cols.rar

جرب هذا الملف اصنافform salim.rar

جرب هذ المرفق cond_format.rar

استبدل الماكرو بهذا Private Sub Worksheet_Change(ByVal Target As Range) With Application .ScreenUpdating = False .EnableEvents = False End With Dim My_Rg As Range Dim x, y, k, c As Long Set My_Rg = Range("a1").CurrentRegion On Error GoTo Exit_Sub x = My_Rg.Rows.Count y = My_Rg.Columns.Count My_Rg.Interior.ColorIndex = xlNo Set My_Rg = My_Rg.Offset(1).Resize(x - 1).Offset(, y - 7).Resize(, y - 10) If Not Intersect(Target, My_Rg) Is Nothing And Target.Cells.Count = 1 Then For k = 1 To x c = Application.CountA(My_Rg.Cells(k, 1).Resize(, y - 10)) If c > 0 Then Cells(k + 1, 2).Resize(1, 16).Interior.Color = 12900829 Next End If Exit_Sub: With Application .ScreenUpdating = True .EnableEvents = True End With End Sub

لا أعلم اذا كان هذا ما تريد Book1 Salim.rar

ربما كان ما تريد انظر الى الورقة Salim 2 مجرد ان تكتب الرقم في الخلية B9 يقوم اكسل بالواجب salim 8_1.rar

المعادلة المطلوبة : اذا كنت تريد عدد هذه الخلايا اليك المعادلة =SUMPRODUCT(--ISNUMBER($A$1:$A$20),--($A$1:$A$20<100)) اذا كنت تريد مجموع الخلايا اصغر من 100 =SUMIF($A$1:$A$20,"<100")

المعادلة تقو م بذلك حتى و لو لم يكن هناك تكرار (جرب استبدل الرقم 10 بأي رقم تريد و شاهد النتيجة)

تم التعديل كما تريد Book100 Salim.rar

يمكن ان يكون الحل هنا salim 8.rar

جرب هذا الماكرو Option Explicit Sub Formula_to_constante() Dim My_Rg As Range Dim x, y As Integer Set My_Rg = Range("b7").CurrentRegion x = My_Rg.Rows.Count y = My_Rg.Columns.Count Set My_Rg = My_Rg.Offset(2).Resize(x - 2, y - 1) Range("h7:h" & x + 4).ClearContents Cells(7, y + 1).FormulaArray = "=IF(OR(ISBLANK(C7:G7)),"""",ROUND(SUM(C7:G7),0))" Range("h7:h" & x + 4).Value = Range("h7:h" & x + 4).Value End Sub

جرب هذا الملف كنموذج cond_format.rar

جرب استبدال الفاصلة ", " بفاصلة منقوطة بالمعادلة";"

جرب هذين الكودين الاول يقوم باخفاء الاعمدة والثاني حذفها اختر ما تريد Sub hid_col() Dim my_rg As Range Set my_rg = Range("a2").CurrentRegion my_rg.Columns.Hidden = False x = my_rg.Rows.Count Set my_rg = Range("a2").CurrentRegion.Offset(1).Resize(x - 1).Resize(1) For i = 1 To my_rg.Count If Application.CountIf(my_rg.Range(Cells(1), Cells(i)), my_rg.Cells(i)) > 1 Then my_rg.Cells(i).EntireColumn.Hidden = True End If Next Set my_rg = Nothing End Sub '============================================================================= Sub del_col() Dim my_rg As Range Set my_rg = Range("a2").CurrentRegion my_rg.Columns.Hidden = False x = my_rg.Rows.Count Set my_rg = Range("a2").CurrentRegion.Offset(1).Resize(x - 1).Resize(1) For i = my_rg.Count To 1 Step -1 If Application.CountIf(my_rg.Range(Cells(1), Cells(i)), my_rg.Cells(i)) > 1 Then my_rg.Cells(i).EntireColumn.Delete End If Next Set my_rg = Nothing End Sub

ارفع نموذج عما تريد لا احد يعمل على التخمين

جرب هذا الماكرو (يجب ان تكون جميع الصفوف تحت اخر صف من البيانات المطلوبة فارغة) Sub del_cel1() ActiveSheet.Range("e2, f2:f3, g2:g4").Delete Shift:=xlUp laste_row = ActiveSheet.Cells(Rows.Count, "A").End(3).Row Range("D1:D" & laste_row).SpecialCells(4).EntireRow.Delete End Sub

لك ما تريد اخي محمد انظر الى الصفحة salim من هذا الملف جلب بيانات بين تاريخين sALIM.rar

بعد اذن اخي و حبيب القلب ياسر انظر الى هذا الملف صفحة Salim dup_Remover_from cel.rar

ربما ينال الاعجاب هذا الملف (بدون كود) جلب بيانات بين تاريخين sALIM.rar

لم تجب على السؤال حول حرف S في الكود(ذلك مهم جداً لمعرفة ما تريد)