سليم حاصبيا

هذه المعادلة في الخلية N3 ثم اسحب نزولاً =CEILING(SUM(H3:M3),0.05)

هذا الماكرو Option Explicit Sub rand_num_generator() Dim i% Dim myStart%: myStart = Application.Min([c2], [d2]) Dim myEnd%: myEnd = Application.Max([c2], [d2]) Dim a() Range("a2").CurrentRegion.ClearContents ReDim a(myEnd - myStart) With CreateObject("System.Collections.SortedList") For i = myStart To myEnd .Item(Rnd) = i Next i i = 0 Do Until i > .Count - 1 a(i) = .GetByIndex(i) i = i + 1 Loop End With Range("a2").Resize(UBound(a) + 1).Value = Application.Transpose(a) Erase a End Sub الملف مرفق Rand_Genarator.xlsm

الكود بهذا الشكل اسرع ولا لزوم لهذه الكمية الكبيرة من الشروط IF الشروط للوصول الى نتيجة عددها 14 Sub copy_date() Application.ScreenUpdating = False Dim start_date As Date: start_date = DateSerial([Q3], [P3], [O3]) Dim end_enter As Date: end_enter = DateSerial([Q4], [P4], [O4]) Dim end_date As Integer: end_date = [O5] Dim my_date As Date Dim x If start_date <= end_enter Then GoTo 1 MsgBox " ادخلت تاريخ البداية " & Range("Q3").Text & "/" & Range("p3").Text & "/" & Range("o3").Text & " يجب تاريخ النهاية يكون مساوي او اكبر من تاريخ البداية " GoTo 2 1: 'ActiveWindow.SelectedSheets.PrintPreview A = MsgBox("هل تود الطباعة بعد المعاينة ؟", vbYesNo + vbQuestion, "طباعة") If A = vbNo Then GoTo 2 Dim i% For i = 0 To end_date - 1 my_date = start_date + i If IsError(Application.Match(Weekday(my_date), Range("O9:O15"), 0)) Then Cells(3, "h") = my_date: Cells(3, "F") = Weekday(my_date) Cells(3, "F").NumberFormat = ("DDDD") ActiveWindow.SelectedSheets.PrintOut End If Next 2: Application.ScreenUpdating = True End Sub

استعمل هذا المعادلة (Ctrl+Shift+Enter) =COUNT(IF(MATCH($A$1:$A$50,$A$1:$A$50,0)=ROW($A$1:$A$50)-ROW($A$1)+1,ROW($A$1:$A$50)-ROW($A$1)+1,"")) الملف مرفق يمكن استعمال هذه ايضاً (Ctrl+Shift+Enter) =SUMPRODUCT(IFERROR(IF(MATCH($A$1:$A$50,$A$1:$A$50,0)=ROW($A$1:$A$50)-ROW($A$1)+1,1,0),0)) يمكن استعمال هذه ايضاً بدون (Ctrl+Shift+Enter) =SUMPRODUCT(1/COUNTIF($A$1:$A$50,$A$1:$A$50&""))-1 123_11.xlsx

اي معدل تريد استخراجه و لا وجود لأي معدل في كل الجدول

اذا كان الرقم ما بعد الفاصلة مؤلف من اكثر من عددين (مثلاً 25487.) يمكن استعمال هذه المعادلة =MID(A2,FIND(".",A2)+1,50)*1

اضرب النتيجة بــ 100

مثال عما تريد Fraction.xlsx

جرب المعادلات في هذا الملف 123_salim.xlsx

هذا الجزء من المعادلة COLUMNS($H1:H$1) يجب ان يكنب COLUMNS($H$1:H1)

حرب ها الملف المنتدى salim2 .xlsx

حرب هذا الماكرو الاسماء في العامود A ابتداء من الخلية 2 Option Explicit Sub extract() Dim i%: i = 2 Dim x%, k%, t% Dim m%: m = 1 Dim arr1, arr2, arr3() Dim my_arr Range("c:c").ClearContents Do Until Range("a" & i) = vbNullString arr1 = Split(Trim(Range("a" & i)), " ") If UBound(arr1) < 3 Then GoTo 1: For x = i + 1 To 6 arr2 = Split(Trim(Range("a" & x)), " ") If UBound(arr2) < 3 Then GoTo 1: For k = 0 To 2 If arr1(k) = arr2(k) Then ReDim Preserve arr3(t) arr3(t) = arr2(k) t = t + 1 End If Next my_arr = Join(arr3, " ") If my_arr <> "" Then Range("c" & m) = my_arr my_arr = "" End If Erase arr3 t = 0 1: Next i = i + 1 m = m + 1 Loop End Sub الملف مرفق Booksalim.xls

حرب ها الملف المنتدى salim1.xlsx

حرب هذا الملف تجزئة .xlsx

هذه المعادلة في الخلية G7 ثم اسحبها يسارا حتى العامود I ونزولاً الى احر صف =INDEX($D$6:$F$6,MATCH(LARGE($D7:$F7,COLUMNS($G$1:G1)),$D7:$F7,0)) الملق مرفق salimللمنتدى.xlsx

جرب هذا الماكرو Option Explicit Sub salim_rand_table() If ActiveSheet.Name <> "Sheet1" Then Exit Sub Dim i%, k%, New_arr() ReDim New_arr(1 To 10, 1 To 2) Dim my_rg As Range Dim myStart%: myStart = 1 Dim myEnd%: myEnd = Application.CountA(Range("a:a")) - 1 Set my_rg = Cells(2, 1).Resize(myEnd) With CreateObject("System.Collections.SortedList") For i = myStart To myEnd .Item(Rnd) = i Next i For k = 1 To 10 New_arr(k, 1) = my_rg.Cells(.GetByIndex(k)) New_arr(k, 2) = my_rg.Cells(.GetByIndex(k)).Offset(, 1) Next End With Range("f2").Resize(UBound(New_arr, 1), UBound(New_arr, 2)).Value = New_arr Erase New_arr: Set my_rg = Nothing End Sub الملف مع الكود اللازم Random word Salim.xls

حرب هذا الشيء salim11.xls

لا يمكن التعامل مغ الصورة يجب رفع الملف بحد ذاته

اذا كان عندتا مجموعة من الارقام من واحد الى N ) N من اختيارك ) و يجب توزيع هذه الأرقام على جدول من M عامود ( M من اختيارك ابضاً) انظر الى الملف المرفق لمعرفة كيف يقوم الاكسل بفعل هذا الشيء الكود Option Explicit Sub CreateNumbers(rg As String, col_num As Long, max_num As Long) Dim n As Long Dim My_row As Long Dim My_col As Long ActiveSheet.Cells(6, 1).CurrentRegion.Clear For n = 0 To max_num - 1 My_row = n \ col_num My_col = n Mod col_num ActiveSheet.Range(rg).Offset(My_row, My_col) = n + 1 Next n End Sub '============================================== Sub give_numbers() Call CreateNumbers(Cells(6, 1).Address, [b2], [c2]) End Sub الملف مرفق Num_table.xlsm

خطأ بسيط في الكود تمت المعالحة Option Explicit Sub Plese_Go() Dim mY_rg As Range Dim I%, k%, x%, m% If ActiveSheet.FilterMode = True Then ActiveSheet.Range("Table2").AutoFilter End If Range("Table2").Columns(3).ClearContents ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4, Criteria1:= _ "FP" Set mY_rg = Range("Table2").Columns(3).SpecialCells(xlCellTypeVisible) x = mY_rg.Areas.Count For k = 1 To x For I = 1 To mY_rg.Areas(k).Rows.Count mY_rg.Areas(k).Rows(I) = m + 1 m = m + 1 Next Next ActiveSheet.Range("Table2").AutoFilter End Sub الملف ادخال بياناتNew_1.xlsm

الماكرو المطلوب Option Explicit Sub Plese_Go() Dim mY_rg As Range Dim I%, k%, x%, m% If ActiveSheet.FilterMode = True Then ActiveSheet.Range("Table2").AutoFilter End If Range("Table2").Columns(3).ClearContents ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4, Criteria1:= _ "FP" Set mY_rg = Range("Table2").Columns(3).SpecialCells(xlCellTypeVisible) x = mY_rg.Areas.Count For k = 1 To x For I = 1 To mY_rg.Areas(x).Rows.Count mY_rg.Areas(k).Rows(I) = m + 1 m = m + 1 Next Next ActiveSheet.Range("Table2").AutoFilter End Sub الملف مرفق ادخال بياناتNew.xlsm

تصحيح رائع (غلطة مطبعية)

بعد اذن اخي على هذه المعادلة تكتي في الحلية D11 وتسحب نزولاً =IF($E11<>"FP",MAX($D$10:D10)+1,"")

تصحيح الكود أولاً انت كتيت متزوج في الورقة 2 و متروج في الورقة 1 و هذا اجد الاخطاء الماكرو المناسب Sub my_filtter_tarheel() Dim myrng1 As Range, myrng2 As Range Set myrng1 = Sheets("mydata").[A1:f2] Set myrng2 = Sheets("Sheet1").Range("a1").CurrentRegion Sheets("mydata").Range("A5").CurrentRegion.ClearContents myrng2.AdvancedFilter 2, myrng1, Sheets("mydata").Range("A5") Set myrng1 = Nothing Set myrng2 = Nothing End Sub الملف مرفق salim_tarhil.xlsm

شاهد هذا القيديو https://www.youtube.com/watch?v=hJ7sVKI_zGU