عبدالله المجرب

السلام عليكم اخي ابو الحسن جرب هذا Sub Abu_Ahmed_NO() Dim Cl As Range LR = Range("A" & Rows.Count).End(xlUp).Row For Each Cl In Range("G2:G" & LR) If Cl.Value = "" Then Cl.Value = 0 Cl.NumberFormat = "0.00" End If Next End Sub

اين المرفق

إذاً جرب هذا Private Sub CommandButton1_Click() w = 2 Do Until Cells(w, 1).Value = "" LR = Sheets("BDORDR").Range("A" & Rows.Count).End(xlUp).Row For i = 1 To 4 Cells(w, i).Copy Sheets("BDORDR").Cells(LR + 1, i) Next w = w + 1 Loop End Sub

جرب هذا الكود Private Sub CommandButton1_Click() w = 2 Do Until Cells(w, 1).Value = "" For i = 1 To 4 Sheets("BDORDR").Cells(w, i) = Cells(w, i) Next w = w + 1 Loop End Sub

السلام عليكم اليك هذا الرابط (المشاركة الثالثة قم بتحميل المرفق ولاحظ ملف الاكسل) http://www.officena.net/ib/index.php?showtopic=34270 ======= ذكرتني بالبدايات

بصراحة لم افهم المطلوب (((فصل اكثر))) ما الفرق لو تم وضع الشيتين الذين تريدهما في ملف اكسل واحد === سيتم دمج الموضوعين

تم اختصار الكود Public x As Integer Sub Sort() Dim WS As Worksheet, MyRng As Range Set WS = Sheets("ناجح وراسب ومحول دور ثانى"): Set MyRng = WS.Range("A7:AA1207") WS.Select Range("AA2").Value = x MyRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ WS.Range("aa1:aa2"), Unique:=False Range("aa2").Select End Sub Sub ناجح_دورثانى() x = 1 Call Sort End Sub Sub راسب_دورثانى() x = 2 Call Sort End Sub Sub محول_دورثانى() x = 3 Call Sort End Sub قم بمسح الكود الاول بالكامل (كل الاجراءات) واستبدله بهذا

قم بازالة الارتباط التشعبي من زر امر الناجح دور ثاني

السلام عليكم اهلاً بك اخي الكريم بين اخوانك نرجو منك الالتزام بقواعد المشاركة وخصوصاً 1. عنوان الموضوع وتوافقه مع الطلب 2. عدم فتح اكثر من موضوع ======= نرجو منك وضع مرفق لرفع مرفق قم بضغطه بالوينرار ثم ارفعه

الجزء الثاني من شرح الصفيف

جرب هذا التعديل Sub Abu_Ahmed() Dim CL As Range, C As Range, Ce As Range LR = Range("B" & Rows.Count).End(xlUp).Row For Each CL In Sheet2.[C3:O3] If CL.Value = [C2] Then For Each C In [B4:B50] For Each Ce In Sheet2.[B4:B60] If C.Row = LR Then Exit Sub If C.Value = Ce.Value And C.Offset(0, 1).Value = 1 Then Sheet2.Cells(Ce.Row, CL.Column) = "لم يحضر" End If If C.Value = Ce.Value And C.Offset(0, 1).Value = "" Then Sheet2.Cells(Ce.Row, CL.Column) = "حضر" End If Next Next End If Next End Sub

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

السلام عليكم جرب هذا الكود Sub Abu_Ahmed() Dim CL As Range, C As Range, Ce As Range For Each CL In Sheet2.[C3:O3] If CL.Value = [C2] Then For Each C In [B4:B9] For Each Ce In Sheet2.[B4:B12] If C.Value = Ce.Value And C.Offset(0, 1).Value = 1 Then Sheet2.Cells(Ce.Row, CL.Column) = "لم يحضر" End If If C.Value = Ce.Value And C.Offset(0, 1).Value = "" Then Sheet2.Cells(Ce.Row, CL.Column) = "حضر" End If Next Next End If Next End Sub

هههههههههههههههههه اخي طاهر قم بالمحاولة مرة اخرى ولكن هذه المرة احفظ الفورم (لتوفير الوقت)

السلام عليكم انا جربت الكود وهو يعمل زي الفل لا تنسى ان تضعه في حدث الصفحة

اخي الفاضل لماذا لم ترفق الفورم في الملف

الاستاذ الفاضل جمال (عمدتنا) سيصبح الكود هكذا Sub Rnd_N_REP() Dim myrange As Range, rr, cc, pp As Integer rr = [B2]: cc = [B1] pp = rr * cc + 1 Range("C3").SpecialCells (xlCellTypeLastCell) Set myrange = Range("C3", [c1000]) myrange.ClearContents ' myrange.Interior.ColorIndex = xlNone Set myrange = Range("C3", [c3].Offset(rr - 1, cc - 1)) 'myrange.Interior.ColorIndex = 6 Randomize For i = 0 To pp - 2 rw = i Mod rr + 3 If rr = cc Then cl = Int(i / cc) + 3 Else cl = i Mod cc + 3 10 x = Int(Rnd * pp) For Each ce In myrange If ce = x Or x = 0 Then GoTo 10 Next ce Cells(rw, cl).Value = x Next i [c3].Select End Sub

اخي وضح اكثر (ما المقصود بشهرين) وليس 60 يوم

ينقل الى قسم الاكسس

على حد فهمي في هذا الكود Sub Circles2() Dim C As Range Dim MyRng As Range Set MyRng = Range("B8:M8,B19:M19,B30:M30,B41:M41,B52:M52,B63:M63,B74:M74,B85:M85") For Each C In MyRng ' عمود رقم الجلوس هو العمود 2 If Cells(C.Row, 2) = 0 Then GoTo 1 If C.Value < Cells(7, C.Column) Or C.Value = "غ" Or C.Value = "غـ" Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left, C.Top, C.Width, C.Height) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.25 End If 1 Next End Sub استبدله بهذا Sub Circles2() Dim C As Range Dim MyRng As Range Set MyRng = Range("B8:M8,B19:M19,B30:M30,B41:M41,B52:M52,B63:M63,B74:M74,B85:M85") For Each C In MyRng ' عمود رقم الجلوس هو العمود 2 If C.Value < Cells(7, C.Column) Or C.Value = "غ" Or C.Value = "غـ" Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left, C.Top, C.Width, C.Height) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.25 End If 1 Next End Sub

السلام عليكم لقد تم اضافة حل هنا http://www.officena.net/ib/index.php?showtopic=40113 ولكنك قمت بفتح موضوع جديد لنفس الطلب والاولى كان هو الاستمرار في نفس الطلب لان فتح موضوعين لنفس الطلب مخالف لقواعد المشاركة لذا سيتم دمج المشاركتين

السلام عليكم اخي الفاضل عنوان الموضوع مخالف لقواعد المشاركة فارجو الانتباه في المستقبل ==== تم تعديل العنوان بما يتناسب والطلب === اليك هذا الرابط لنكوذج فاتورة http://www.officena.net/ib/index.php?showtopic=24191 او هذا http://www.officena.net/ib/index.php?showtopic=28901 واستخدم خاصية البحث فالمنتدى عامر

السلام عليكم اضافة لحل الاستاذ ابونصار جرب هذا Private Sub ComboBox1_Change() [B2].Value = ComboBox1.Value End Sub

السلام عليكم جرب المرفق تم استخدام دالة من مشاركة للاستاذ ابواسامة العينبوسي من اجل تفقيط الرقم انجليزي فرق بين تاريخين وتفقيط.rar

السلام عليكم استعمل هذا الكود في زر أمر Sub Abu_Ahmed() Dim cl As Range For Each cl In [G1:G7] If Application.CountIf([A1:D3], cl) = 0 Then [E1] = cl Next End Sub