سليم حاصبيا

استبدل الرقم 100 في المعادلات بأي رقم تريد (فليكن رقم اخر صف أو اكثر)

جرب هذه المعادلة في الخلية C2 =SUMPRODUCT(($B$2:$B$100=B2)*($A$2:$A$100=A2)) و هذه في الخلية D2 =SUMPRODUCT((مصنف1!$B$2:$B$100=B2)*(مصنف1!$A$2:$A$100=A2))

الكود فقظ انا وضعته و لم أجربه لكن في رأي ان Next يجب ان توضع بعد End If وليس قبل End sub حتى لا تتكرر عبارة  N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181),  عند كل حلقة تكرارية ليبدو الكود بهذا الشكل Option Explicit Sub Click3() Application.ScreenUpdating = False On Error GoTo 1 Dim ws As Worksheet: Set ws = Sheets("add") Dim N, C2 As Range Dim I% ' On Error Resume Next For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row) If N.Value = "محمود" Or N.Value = "احمد" Then For I = 111 To 256 If I = 117 Or I = 164 Or I = 183 Then I = I + 1 If I = 180 Then I = I + 2 N.Offset(0, I) = vbNullString End If Next N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2)) 1: Application.ScreenUpdating = True End Sub

بالنسبة لعدد مواد الرسوب هذه المعادلة في الخلية w14 وتسحب نزولاُ =SUMPRODUCT(--(G14:R14< $G$13:$R$13))

يعد اذن اخي على هذا الكود ربما يكون اسرع قليلاٌ لانه يعنمد على المصفوفات Sub move_data() Sheets("تصفية").Cells.ClearContents Dim arr() Dim i%, m%: m = 1 For i = 1 To 50 If i = 11 Then i = 44 ReDim Preserve arr(1 To m) arr(m) = i m = m + 1 Next m = 1 For i = LBound(arr) To UBound(arr) Sheets("تصفية").Cells(2, m).Resize(100, 1).Value = _ Sheets("البيانات").Cells(2, arr(i)).Resize(100, 1).Value m = m + 1 Next Erase arr End Sub

اختصار الكود Option Explicit Sub Click3() Application.ScreenUpdating = False On Error GoTo 1 Dim ws As Worksheet: Set ws = Sheets("add") Dim N, C2 As Range Dim I% ' On Error Resume Next For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row) If N.Value = "محمود" Or N.Value = "احمد" Then For I = 111 To 256 If I = 117 Or I = 164 Or I = 183 Then I = I + 1 If I = 180 Then I = I + 2 N.Offset(0, I) = vbNullString Next End If N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2)) Application.ScreenUpdating = True 1 End Sub

جرب هذه المعادلة ( Ctrl+Shift+Enter ) في الخلية D1 .واسحب نزولاُ =IFERROR(INDEX($A$1:$A$11,SMALL(IF(COUNTIF($A$1:$A$11,$B$1:$B$11),COUNTA($A$1:$A$11)+1,ROW($A$1:$A$11)-ROW($A$1)+1),ROWS($A$1:A1))),"")

بعد اذن اخي زيزو هذا الكود Sub Numeration() Range("A1").Select Do While ActiveCell.Offset(0, 1) <> "" ActiveCell.FormulaR1C1 = "1" Selection.DataSeries Rowcol:=xlColumns, Stop:=10 ActiveCell.Offset(10, 0).Select Loop Range("A1").Select End Sub

جرب هذا الملف الكود Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Application.EnableEvents = False If Target.Column = 1 And Target.Count = 1 Then Dim x1, x2, x3, st Dim r1%, r2%, r3% st = Target.Value Dim rg1 As Range, rg2 As Range, rg3 As Range r1 = Sheets("data1").Cells(Rows.Count, 1).End(3).Row r2 = Sheets("data2").Cells(Rows.Count, 1).End(3).Row r3 = Sheets("data3").Cells(Rows.Count, 1).End(3).Row Set rg1 = Sheets("data1").Cells(1, 1).Resize(r1) Set rg2 = Sheets("data2").Cells(1, 1).Resize(r2) Set rg3 = Sheets("data3").Cells(1, 1).Resize(r3) x1 = Application.CountIf(rg1, st) x2 = Application.CountIf(rg2, st) x3 = Application.CountIf(rg3, st) If x1 + x2 + x3 > 1 Then MsgBox "the entred value is not unique" & Chr(10) & "I Can't Except that" Target.Value = vbNullString End If End If Application.EnableEvents = True End Sub الملف مرفق No Repitition in 3sheets.xlsm

اليك هذه المعادلة لهذا الامر =SUMPRODUCT(--($D$3:$O$3=P$3)*ISNUMBER($D4:$O4)) تكتبها في الخلية P4 وتسحب يساراً عامود واحد ثم نزولاًاُ

جرب هذا الملف Salim (2).xlsx

جرب هذا الملف Data_Val.xlsm

جرب هذا الماكرو Option Explicit Sub extract_common_rows() Dim tb1 As Range, tb2 As Range Dim r1%, r2%, i%, j%, m%: m = 3 Range("I2").CurrentRegion.ClearContents Set tb1 = Range("a3").CurrentRegion Set tb2 = Range("e3").CurrentRegion r1 = tb1.Rows.Count: r2 = tb2.Rows.Count For i = 1 To r1 For j = 1 To r2 If tb1.Cells(i, 1) = tb2.Cells(j, 1) _ And (tb1.Cells(i, 1).Offset(0, 1) = tb2.Cells(j, 1).Offset(0, 1)) _ And (tb1.Cells(i, 1).Offset(0, 2) = tb2.Cells(j, 1).Offset(0, 2)) Then Range("i" & m).Resize(1, 3).Value = tb1.Cells(i, 1).Resize(1, 3).Value m = m + 1 End If Next Next End Sub الملف مرفق match tow tables.xlsm

ريما كان هذا نموذجاً عما تريد جرب تغيير محتوى الخلية A1 و انظر الى الخلية G2 last_regiration.xlsm

بعد اذن اخي علي و زيادة في اثراء الموضوع هذه المعادلة =IF(A1="","",VLOOKUP(A1,{1,"راسب";50,"ناجح";65," جيد";75,"جيد جدا";85," ممتاز";95,"ممتاز مع مرتبة الشرف"},2))

يمكن استعمال هذه المعادلة (ضعها اينما تريد ليس من الضروري الخلية A1) اسحب على الصفوف ثم نزولاً(قدر ما تريد) =ROWS($A$1:A1)*COLUMNS($A$1:A1) للمزيد هذا الملف MULT_TABLE.xlsx

جرب هذا الملف في مجال اليحث يجب كتابة (3 أخرف على الاقل) و الضغط على انتر activité _salim.xls

يمكن استعمال هذه المعادلة (بدون عامودمساعد) لاظهار اصغر تاريخ =MIN(IF($C2=$B$8:$B$100,$C$8:$C$100)) هذه لاظهار اكبر تاريخ =MAX(IF($C2=$B$8:$B$100,$C$8:$C$100)) المعادلات (Ctrl+Shift+Enter) و ليس (Enter) وحدها ليس شرط ان تكون التواريخ مرتبة تصاعدياً او تنازلياً

اضغط على الزر RUN في الصفحة SALIM من هذا الملف SALIM_ROWS.xls

المعادلة هي معادلة صفيف (Array formula) كي تعمل يجب بعد كتابتها الضغظ على (Ctrl+Shift+enter) و ليس Enter وحدها

جرب هذا الملف Fatoura.xlsx

جرب هذا الماكرو (دون حلقات تكرارية) من سطر واحد Option Explicit Sub del_rows() Range("Q5:Q" & Range("Q5").CurrentRegion.Rows.Count + 6) _ .SpecialCells(4).EntireRow.Delete End Sub

جرب هذا الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim x% If (Target.Column >= 3 Or Target.Column <= 6) _ And Target.Count = 1 Then If IsEmpty(Cells(Target.Row, 1)) Or IsEmpty(Cells(Target.Row, 2)) Then x = Application.CountA(Range(Cells(Target.Row, 3), Cells(Target.Row, 6))) If x = 4 Then Cells(Target.Row, 1) = Date + Time Cells(Target.Row, 2) = Application.UserName End If End If End If Application.EnableEvents = True End Sub

هذا الكود Sub remove_const() With Selection If .Count > 1 Then Exit Sub .Offset(, 1 - .Column) _ .Resize(, .CurrentRegion.Columns.Count). _ SpecialCells(2, 23).ClearContents End With End Sub

جرب هذا الملف Crazy_date.xlsx