سليم حاصبيا

جرب هذه المعادلة في الخلية C2 (اسحب نزولاً) =SUMPRODUCT(--($A$2:$A$16=$A2),$B$2:$B$16) هناك موضوع مشابه كتبته على هذا العنوان (عسى ان ينال الاعجاب) http://www.officena.net/ib/topic/83103-لائحة-يالاسماء-حسب-الديون/

تم التعديل Option Explicit Sub give_data() Dim Fst_sh As Worksheet: Set Fst_sh = Sheets("Difference2") Dim Trg_Sh As Worksheet: Set Trg_Sh = Sheets("Salim") Dim lr%, i%, k%, m%, t%, tt% Dim My_Rg As Range i = 2 m = 2 Trg_Sh.Range("a1").CurrentRegion.Offset(1).ClearContents lr = Application.Max(Fst_sh.Range("a:a")) For i = 2 To lr Set My_Rg = Fst_sh.Range("C" & i & ":K" & i) t = Application.CountIf(My_Rg, 0) tt = Application.CountIf(My_Rg, "") If t + tt <> 9 Then Trg_Sh.Cells(m, 1).Resize(, 11).Value = _ Fst_sh.Cells(i, 1).Resize(, 11).Value m = m + 1 End If Next End Sub لتعديل نطاق العمل استبدل الحرف K بالحرف الذي يلائم اخر عامود في الجدول (.....L,M,Z ) و استبدل الرقم 9 بمجموع الاعمدة ناقص 2 ( العامود K=11 العامود L=12 العامود F=6 ,و هكذا ) و الرقم 11 بعدد الاعمدة August_salim.xlsm

ا نت طلبت ذلك من خلال قولك محتاج طريقه لترتيب الارقام عشوائي شرح عمل الكود: ======================================================= الكود يأخذ مجموعة عشوائية محددة (حسب الطلب ) من الاعداد بين عددين ومن ثم يرتبها تصاعديا مثلاُ بين 50 و 500 المطلوب 5 أعداد احد النتائج المحتملة (من بين ألوف الألوف) 350 425 100 260 61 الكود يكتبها هكذا : 61 100 260 350 425 هنا ليس ترتيب لارقام متسلسلة بل ترتيب تصاعدي لارقام عشوائية للمزيد يرجى الاطلاع على هذا الملف في العنوان التالي: https://www.officena.net/ib/topic/85730-كيف-نختار-مجموعة-عشوائية-من-التلاميذ/ =================================================================== اذا كنت لا تريد الترتيب احذف او ( علّق) السطر الرابع من الاسفل من الكود ليصبح هكذا Option Explicit Sub Sorting_Rand_Numbers() Dim i%, k% Dim myStart%: myStart = Application.Min([c2], [d2]) Dim myEnd%: myEnd = Application.Max([c2], [d2]) Dim a() Range("b:b").ClearContents Dim x: x = [e2] If Not IsNumeric(x) Or IsEmpty(x) Then _ MsgBox "Wrong input in $E$2": Exit Sub If x < 1 Or Int(x) <> x Or x > myEnd - myStart + 1 Then x = myEnd - myStart [e2] = x End If ReDim a(myEnd - myStart) With CreateObject("System.Collections.SortedList") Randomize For i = myStart To myEnd .Item(Rnd) = i Next i For i = 0 To .Count - 1 a(i) = .GetByIndex(i) Next End With With Range("b2") .Resize(UBound(a) + 1).Value = Application.Transpose(a) .Offset(x).Resize(myEnd - myStart + 1 - x).ClearContents ' .Resize(x).SortSpecial End With Erase a End Sub

اكتب قبل الرقم هذا الحرف " ' " حرف الــ ط (الكيبورد باللغة الاجنبية)

زيادة في اثراء الموضوع هذا الملف مع كود سريع جداً (10000 رقم في 0.8 من الثانية) تختار منها ما تريد Sorting_Rand.xlsm

بعد اذن اخي علي هذا الملف Conditional_Rand.xlsm

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

جرب الان August Payroll_salim.xlsm

جاري العمل على الملف

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

تم التعديل على الملف ليعمل عندك الورقة مجمية (بدون كلمة سر لعدم العبث المعادلات عن طريق الخطأ) Salim_Sum WITH PROTECTION.xlsx

اخي رعداذهب الى هذا الهنوان هناك مشاركة بهذا الموضوع قد تكون ما تريده https://www.officena.net/ib/topic/83103-لائحة-يالاسماء-حسب-الديون/

الملف كبير جداً يا اخي ارفع ملفاً مختصراً (من 10 الى 15 صف ) لمعرفة كيفية سير المعادلات او الكود اذا لزم الامر رجاءً: بدون عدو الكودات والمعادلات الأول (اعني الخلايا المدمجة) و بدون الوان تنسيقية تبهر النظر

جرب هذا الكود Option Explicit Sub transfer() Dim Target_Sh As Worksheet Set Target_Sh = Sheets("الغياب") Dim Single_sh As Worksheet Dim My_row% Dim i%, s# Dim ara As Range Dim Blank_Range As Range My_row = Target_Sh.Cells(Rows.Count, 1).End(3).Row + 1 For Each Single_sh In Worksheets If Single_sh.Name = Target_Sh.Name Then GoTo 1 Set Blank_Range = Single_sh.Range("a1") _ .CurrentRegion.Columns(5) On Error Resume Next Set Blank_Range = Blank_Range.SpecialCells(xlCellTypeBlanks) s = Err.Number If s <> 0 Then s = 0: GoTo 1 s = 0 For Each ara In Blank_Range.Areas Target_Sh.Cells(My_row, 1).Resize(ara.Rows.Count, 5).Value = _ ara.Offset(, -4).Resize(ara.Rows.Count, 5).Value My_row = My_row + ara.Rows.Count Next 1: Next End Sub الملف مرفق AAA_Salim.xlsm

ممكن ذلك ترتيب ابجدي.New.xlsx

احنا اتفقنا بلاش Activate ولا Select ديه ولا لزوم لهذا السطر نهائياً ws.Range("A" & cel.Row).Resize(1, 9).Activate يكفي هذا الماكرو Sub Fixe_data() Dim lr% With Sheets(1) lr = .Range("A2").CurrentRegion.Rows.Count .Range("A2").Resize(lr, 9).Value = .Range("A2").Resize(lr, 9).Value End With End Sub او اكثر اختصاراً Sub fix_data() With sheets("1").Range("A1").CurrentRegion .Value =.Value End With End Sub

في محل للعصير يتم بيع بالجملة والمفرق (صناديق و قناني) المطلوب موضح في هذه الصورة تم انشاء UDF لهذه الحالة في هذا الملف عسى ان ينال الاعجاب case_butil_salim.xlsm

الاخ شكري 1- الخطأ في الكود عندك كلمة xlpastevalues انت كتبتها بدون حرف t 2-استعمال Option Explicit في أول الكود من الضروربات (هذه الخاصية لا تسمح بالأخطاء ولا تسمح بمرور اي متغير لم يتم ذكره في Dim) 3- لا ضرورة لان البرنامج يقوم بفحص كل خلية حتى اخر صف في الصفخة 1 العامود D اذا كانت فارغة أو لا اذ يكفي ان يتوقف عند أول خلية فارغة من العامود D ( بواسطة Do Loop) 4-لا ضرورة لان يقوم البرنامج بتحديد الصفحة المراد التقل اليه بواسطة Sheets(x).activate ( يمكن النقل النقل بدون تجديدها) 5- ان عملية Copy Paste و Select من العمليات المرهقة لاي برنامج لذلك قدر الامكان الابتعاد عنها خاصة اذا كان النطاق الذي تريد تجديده موجود في صفحة اخرى غبر التي يعمل عليها الكود (يتم تحدبد نفس التطاق لكن قي صفحة العمل) 6- جرب هذا الكود بدون Copy Paste و Select Option Explicit Sub copy_salim() Dim My_Sh As Worksheet Dim First_sh As Worksheet Dim i%: i = 2 Dim lr% Set First_sh = Sheets("1") Do Until First_sh.Range("D" & i) = "" Set My_Sh = Sheets(First_sh.Range("D" & i).Value) lr = My_Sh.Cells(Rows.Count, 1).End(3).Row + 1 My_Sh.Range("a" & lr).Resize(, 9).Value = _ First_sh.Range("a" & i).Resize(, 9).Value i = i + 1 Loop With First_sh .Range("A2:E100").ClearContents .Range("i2:i100").ClearContents End With Set First_sh = Nothing: Set My_Sh = Nothing End Sub

تم التعديل على الكود لمنع هذا الشي Option Explicit Dim Old_value Dim New_value Private Sub Worksheet_SelectionChange(ByVal Target As Range) Old_value = Target.Cells(1, 1).Value End Sub '============================================== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False On Error GoTo Final_Step If Intersect(Target, Range("A1:F12")) Is Nothing Then GoTo Final_Step New_value = Target.Value If Target.Cells.Count > 1 Then Application.Undo GoTo Final_Step End If If Old_value = "" And Target.Cells.Count > 1 Then Application.Undo GoTo Final_Step End If If Old_value = "" Then Target.Value = New_value Else Application.Undo End If Final_Step: Application.EnableEvents = True End Sub

ربما يكون المطلوب working_hours.xlsx

السلام عليكم عندنا جدول من صفوف كثيرة بحيث لا تتسع لها صفحة واحدة كيف نقوم بطباعة كل عدد محدد من الصفوف (انت تختاره) مع جمع الارقام في كل ورقة طباعة في اسفلها و تكرار رأس الجدول في كل ورقة طباعة و اذا كانت قسمة عدد الصفوف على العدد الذي اخترته لا تساوي عدداً صحيحاً كيف يتصرف الاكسل كل ذلك في هذا الملف Smart_Printing.xlsm

جرب ما يلي formule.xlsx

اعمل نسخة للصفحة و اعطها الاسم الذي تشاء (لا ضرورة للماكرو في هذه الحالة)

بعد اذن اخي علي جرب هذا الملف Association_SALIM.xlsm

أحد الحلول (المفيدة) لكن بواسطة عامودين مساعدين كبداية جيد لكن انصح باستعمال معادلة واحدة في j2 و سحبها نزولاً =SUM(INT((WEEKDAY($E$2-(IF(ROWS($J$2:J2)=1,7,ROWS($J$2:J2)-1)))+$D$2-$E$2)/7))