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

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

السلام عليكم

 

لاثراء الموضوع هذه باستخدام sumproduct

 

=SUMPRODUCT(C1:C13*((A1:A13="اثاث")+(A1:A13="مفروشات")))

 

 

تحياتي للجميع 

الاخ / احمد عبدالناصر

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

اخي الدالة سليمة لكنك لم تلاحظ ان شروط الجمع معرفه بالخلايا A1 و A2 

=hussien_sumif(A1:A13,"اثاث","مفروشات",3)

استخدم هذه الصيغة لتتمكن من الفرز

في ورقة رقم 2 ادخل اسماء المحلات التي تريدها

في خانة رقم المحل اكتب رفم المحل

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

اما الدالة iferror فهي لتجاهل الخطأ ان وجد

اكثر من ممتاز فقد اوفي بالغرض تماما

ارجو منك توضيح طريقة اضافة الشرح هذا

استاذي / عبدالله المجرب

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

وطبيعي ان لايرتقي حل التلميذ لمستوى حل استاذه  

استاذنا وعالمنا الجليل عبدالله المجرب

كل يوم ننهل من بحر علمك اكثر واكثر

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

مثل الصورة المرفقة

والشرح الذي اضفته للدالة هل اضفته في كود الدالة ام اين ؟

ولك جزيل الشكر