حسين العصلوجى

Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim ws As Worksheet Dim ws2 As Worksheet Dim Sh_Name As String Sh_Name = ComboBox1.Text & "-" & ComboBox2.Text Sheets.Add ActiveSheet.Name = Sh_Name Set ws = Sheets("ÌãíÚ ÇáÕÝæÝ") Set ws2 = Sheets(Sh_Name) iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row For x = 1 To iRow iRow2 = ws2.Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row If ws.Cells(x, 3).Value = ComboBox2.Value And ws.Cells(x, 4).Value = ComboBox1.Value Then For e = 0 To 3 ws2.Cells(iRow2, e + 1) = ws.Cells(x, e + 1) Next End If Next c = Application.Ceiling((Application.CountA(ws2.Range("c1:c65536")) / ComboBox3.Value), 1) i = 2 Z = 1 For x2 = 1 To (ComboBox3.Value - 1) ws2.Select Set srng = ws2.Range("A" & (c * x2 + i)).Resize(1, 4) srng.Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove With Selection .HorizontalAlignment = xlCenter .MergeCells = False .Interior.TintAndShade = -0.149998474074526 End With Selection.Merge ActiveCell.FormulaR1C1 = "ÇáÕÝ " & ComboBox1.Text & " - " & "ÇáÞÓã " & ComboBox2.Text & " - " & "ÇáãÌãæÚÉ " & Z i = i + 1 Z = Z + 1 Next ws.Range("a2:d2").Copy ws2.Cells(1, 1).Select ActiveSheet.Paste irow3 = ws2.Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row ws2.Cells(irow3, 1).Select Set rng3 = ws2.Range("A" & (irow3)).Resize(1, 4) rng3.Select With Selection .HorizontalAlignment = xlCenter .MergeCells = False .Interior.TintAndShade = -0.149998474074526 End With Selection.Merge ActiveCell.FormulaR1C1 = "ÇáÕÝ " & ComboBox1.Text & " - " & "ÇáÞÓã " & ComboBox2.Text & " - " & "ÇáãÌãæÚÉ " & Z Columns("A:D").EntireColumn.AutoFit ActiveSheet.DisplayRightToLeft = True Application.CutCopyMode = False UserForm1.Hide End Sub تفضل المرفق لعله يفي بالمطلوب توزيع الطلبة -h.rar

وضحت الفكرة وساقوم بعمل المطلوب ان شاء الله

اخي العزيز الي قلبي كثيرا / حماده عمر ااشكرك كثيرا علي كلماتك الطيبه واوضح لك اني قمت بهذا التعديل في المرفق الاول ولكن الاخ / كرتوتي لديه ثلاثة انواع من المدخلات فواتير وسندات تسلم وسندات قبض ويريد عمل مسلسل خاص بكل فئة علي حده هذا علي حسب ما فهمته من كلامه لكن هو عند الادخال لايحدد نوع المدخل لذلك طلبت منه اضافة بند في الفورم لتحديد نوع المدخل هل فاتورة ام سند قبض ام سند تسليم لعمل المسلسل الصحيح

الاخ / كرتوتي اذا كنت تقصد عمل مسلسل خاص لرقم الفاتورة وسندات القبض والتسلم كل علي حده فلابد عند الادخال ان يتم تعريف نوع المدخل فاتورة ام سند لاختيار المسلسل الخاص به وهذا غير موجود بالفورم الذي تعمل عليه فاما ان تضيف هذا التصنيف اثناء الادخال او في خانة المرجع تلتزم لاللي موجود في الكومبو بوكس ولاتغيره حتي يكون هو التصنيف الذي عليه يتم عمل المسلسل وفهذه الحال اضف هذا الكود للفورم وسوف يعمل التسلسل Private Sub ComboBox4_Click() TextBox4.Value = ComboBox4.Value c = 1 Set myrange = Sheets(TextBox10.Text).Range("d1:d100") For Each cel In myrange If cel = TextBox4.Text Then c = c + 1 End If Next TextBox1.Value = c End Sub

تفضل المرفق لعله يكون المطلوب سجلات الحساب.rar

تفضل اخي المرفق الاول بالمعادلات الثاني كود لعله يفى بالغرض Book1.rar Book2.rar

الاخ / هادى طلب غير واضح لى فمثلا اذا اخترت عدد الشعب 3 علي اي اساس يتم التوزيع ام ان توزيع اي طلاب مهما كان الصف او او القسم المهم فقط ان يتم تقسيم الطلاب بالكامل الي 3 اقسام عموما انا عملت الملف ده علي حسب مافهمت من كلامك لعله يفى بالغرض husin.rar

http://www.officena.net/ib/index.php?showtopic=45760&hl الرد هنا الموضوع مكرر

اثراءا للموضوع ده حل اخر husin1.rar

سؤالى لاخي / احمد لماذا اضفت الشرط If Target.Cells.Count = 1

والله اخي احمد لم اري ردك الا بعد ما وضعت الحل باعتذر لك تفضل اخي المرفق لعله يفي بالغرض المصنف1.rar

الاخ / صفوت جرب المرفق واتمني ان يفى بالغرض صفحة التسجيل.rar

For x = 8 To Range("a65536").End(xlUp).Row If Cells(x, 1) = 0 Then Rows(x).Hidden = True End If Next اثراءا للموضوع كود اخر مختصر وسريع جدا فالتنفيذ تعديل على ماكرو+.rar

جرب المرفق ان شاء الله يفي بالغرض activecell (2).rar

اتمني ان اكون وفقت في عمل المطلوب وان يفى بالغرض Officena.rar

عملت لك هذا علي حسب ما فهمت من كلامك فانا لم افهم هل انت لاتريد الماكرو فقط ام انك لاتريد اكواد نهائيا اتمني ان يفي المرفق بالغرض activecell.rar

يمكنك نسخ نفس الكود في صفحة التنسيق الشرطى وسيعطيك نفس النتيجة

الملف بعد التعديل hh.rar

تفضل اخي المرفق لعله يفي بالغرض تلوين الأعمدة بشرط.rar

الاخ / احمد عبدالناصر حل ممتاز وليس بغريب عنك فدوما حلولك مميزه

اخي الدالة سليمة لكنك لم تلاحظ ان شروط الجمع معرفه بالخلايا A1 و A2 =hussien_sumif(A1:A13,"اثاث","مفروشات",3) استخدم هذه الصيغة لتتمكن من الفرز

في ورقة رقم 2 ادخل اسماء المحلات التي تريدها في خانة رقم المحل اكتب رفم المحل في خانة اسم المحل تكون الدالة vlookup والتي تقوم بالبحث عن رقم المحل في الورقة 2 وجلب اسم المحل في خانة الاسم اما الدالة iferror فهي لتجاهل الخطأ ان وجد

اكثر من ممتاز فقد اوفي بالغرض تماما ارجو منك توضيح طريقة اضافة الشرح هذا

استاذي / عبدالله المجرب كلامك صحيح تماما وهو ما قدمته في حلك ولكن انا وضعت هذا كحل بديل لمن لايريد ان يدخل في مسالة تعديل الاكواد حتي تتلائم مع احتياجاته وطبيعي ان لايرتقي حل التلميذ لمستوى حل استاذه

استاذنا وعالمنا الجليل عبدالله المجرب كل يوم ننهل من بحر علمك اكثر واكثر ما اضفته مطلوب لكن اريد شرح لوسائط الدالة مثلا لما اقف في خانة المدى بيكتب تحت في التعليمات ما يفترض ادخاله في هذه الخانة مثل الصورة المرفقة والشرح الذي اضفته للدالة هل اضفته في كود الدالة ام اين ؟ ولك جزيل الشكر