Ali Mohamed Ali

وعليكم السلام-تفضل أسماء جميع العاملين بالمدرسة.xlsm

وعليكم السلام استاذ صالح .. جرب هذا وأتمنى ان يفيدك فقد تم نقاش وتناول هذا الموضوع من قبل عمل برنامج يعمل علي الموازين التي تطبع باركود كيف يتم احتساب وزن وسعر واسم الصنف في ملصق الباركود

تفضل جرب الملف هكذا راتب التعويض .xlsm

السلام عليكم الأمر بكل بساطة لا يوجد به خطأ فقط كان عليك جعل تنسيق هذه الخلية هكذا -تفضل [h]:mm sum attendance1.xls

وعليكم السلام-يمكنك استخدام هذه المعادلة =SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,1,"A"),2,"B"),3,"C"),4,"D"),5,"R"),6,"E"),7,"M"),8,"K"),9,"N"),0,"V") CODAGE1.xlsx

ممتاز استاذ محمد جعله الله فى ميزان حسناتك ورحم الله والديك

بارك الله فيك استاذ سليم وبعد اذن حضرتك ولإثراء الحل بالمعادلات العادية -تفضل نسب وشرائح.xlsx

لديك حق استاذى الكريم سليم فنبهنا كثيراً جداً على ضرورة رفع ملف بالمشاركة ولكن بعد اذن حضرتك -يمكنك استخدام الكود هكذا , فكان عليك وضع جملة End If بالكود ثلاثة مرات أخرى قبل كلمة Next كما ترى Sub AAD_ASD() Dim R As Integer, M As Integer, N As Integer, O As Integer, p As Integer, Q As Integer, S As Integer, T As Integer Sheets("كهرباء").Range("A4:DZ1000").ClearContents Sheets("ميكانيكا").Range("A4:DZ1000").ClearContents Sheets("نجارة أثاث").Range("A4:DZ1000").ClearContents Sheets("زخرفة").Range("A4:DZ1000").ClearContents Sheets("صحي").Range("A4:DZ1000").ClearContents Sheets("إنشاءات").Range("A4:DZ1000").ClearContents Sheets("تشطيبات").Range("A4:DZ1000").ClearContents M = 4: N = 4: O = 4: p = 4: Q = 4: S = 4: T = 4 Application.ScreenUpdating = False For R = 4 To 1000 If Cells(R, 4) = "كهرباء" Then Range("A" & R).Resize(1, 115).Copy Sheets("كهرباء").Range("A" & M).PasteSpecial xlPasteValues Sheets("كهرباء").Range("A" & M).PasteSpecial xlPasteFormats Application.CutCopyMode = False M = M + 1 ElseIf Cells(R, 4) = "ميكانيكا" Then Range("A" & R).Resize(1, 115).Copy Sheets("ميكانيكا").Range("A" & N).PasteSpecial xlPasteValues Sheets("ميكانيكا").Range("A" & N).PasteSpecial xlPasteFormats Application.CutCopyMode = False N = N + 1 ElseIf Cells(R, 4) = "نجارة أثاث" Then Range("A" & R).Resize(1, 115).Copy Sheets("نجارة أثاث").Range("A" & O).PasteSpecial xlPasteValues Sheets("نجارة أثاث").Range("A" & O).PasteSpecial xlPasteFormats Application.CutCopyMode = False O = O + 1 ElseIf Cells(R, 4) = "زخرفة" Then Range("A" & R).Resize(1, 115).Copy Sheets("زخرفة").Range("A" & p).PasteSpecial xlPasteValues Application.CutCopyMode = False p = p + 1 If Cells(R, 4) = "صحي" Then Range("A" & R).Resize(1, 115).Copy Sheets("صحي").Range("A" & Q).PasteSpecial xlPasteValues Sheets("صحي").Range("A" & Q).PasteSpecial xlPasteFormats Application.CutCopyMode = False Q = Q + 1 If Cells(R, 4) = "إنشاءات" Then Range("A" & R).Resize(1, 115).Copy Sheets("إنشاءات").Range("A" & S).PasteSpecial xlPasteValues Sheets("إنشاءات").Range("A" & S).PasteSpecial xlPasteFormats Application.CutCopyMode = False S = S + 1 If Cells(R, 4) = "تشطيبات" Then Range("A" & R).Resize(1, 115).Copy Sheets("تشطيبات").Range("A" & T).PasteSpecial xlPasteValues Sheets("تشطيبات").Range("A" & T).PasteSpecial xlPasteFormats Application.CutCopyMode = False T = T + 1 End If End If End If End If Next MsgBox ("الحمد لله تـــم ترحيل الناجحين و الراسيسن إلى أوراق عمل جديدة ") Application.ScreenUpdating = True End Sub

وعليكم السلام -تم عمل تنسيقات شرطية للمطلوب بهذه المعادلات ... للون الأحمر =COUNTIF($A2:$D2,A2)=2 واللون الأخضر =COUNTIF($A2:$D2,A2)=3 أما اللون البنى فهكذا =COUNTIF($A2:$D2,A2)>=4 التكرار لمرة ومرتين.xlsx

وعليكم السلام فقط يمكتك استخدام هذه المعادلة =INDIRECT("'"&B3&"'!e21") Test1.xlsx

بسيطة وسهلة لا تفعل أكثر مما تراه بالصورة

وعليكم السلام-تفضل يمكنك استخدام هذا الكود Sub DeleteRow() Dim r As Long Dim FirstRow As Long Dim LastRow As Long FirstRow = 8 LastRow = Cells(Rows.Count, "I").End(xlUp).Row - 1 For r = LastRow To FirstRow Step -1 If Cells(r, "i") = "VISUALISEUR" Then Rows(r).Delete End If Next r End Sub VISUAL1.xlsm

بالطبع بعد اذن استاذنا الكبير سليم حاصبيا .... بالتأكيد يمكنك هذا من خلال اضافة هذا الكود بأكواد الفورم مع تعديل عرض العمود الذى تريده من داخل الكود Private Sub UserForm_Initialize() With Me.ListBox1 .ColumnWidths = "0;75;100;75;75;75;75;80;75;70" .Width = 700 End With End Sub كما ان هناك طريقة أخرى بدون أكواد وهى كتابة عرض الأعمدة التى تريده من داخل خصائص الليست بوكس ColumnWidths وذلك كما ترى بالصورة

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

وعليكم السلام-لك ما طلبت Salary Change1.xlsm

بارك الله فيك وزادك الله من فضله بالطبع هذه البرامج من البرامج المفيدة والنافعة والهامة والمطلوبة لعدد كبير جداً من الأعضاء ... جعله الله فى ميزان حسناتك ورحم الله والديك

وعليكم السلام-تم تغيير المعادلة بمعادلة أخرى أخفف منها وليست مصفوفة -تفضل =IFERROR(INDEX($A$2:$A$14,AGGREGATE(15,6,ROW($A$1:$A$14)/(MATCH($A$2:$A$14&$B$2:$B$14,$A$2:$A$14&$B$2:$B$14,0)=ROW($A$1:$A$14)),ROWS($2:2))),"") ترتيب التاريخ1.xlsx

وعليكم السلام-بعد اذن الأستاذ خيماوى ولإثراء الحل يمكنك ايضاً استخدام هذا الكود أو يمكن أيضاً بإستخدام المعادلات وهذه المعادلة للإسم =IFERROR(INDEX(A:A,AGGREGATE(15,6,ROW($1:$900)/(LEN($B$1:$B$900)-LEN(SUBSTITUTE($B$1:$B$900,"-",""))+1>=COLUMN($A:$J)),ROW(A1))),"") أما معادلة الكود فتكون كالتالى =IF(H2="","",TRIM(MID(SUBSTITUTE("-"&VLOOKUP(H2,$A$1:$B$900,2,0),"-",REPT(" ",99)),COUNTIF(H$2:H2,H2)*99,99))) Sub Demo() Dim Ary As Variant, Nary As Variant, Sp As Variant Dim r As Long, nr As Long, i As Long Ary = Range("A1").CurrentRegion.Value2 ReDim Nary(1 To UBound(Ary) * 100, 1 To 2) For r = 1 To UBound(Ary) Sp = Split(Ary(r, 2), "-") For i = 0 To UBound(Sp) nr = nr + 1 Nary(nr, 1) = Ary(r, 1) Nary(nr, 2) = Sp(i) Next i Next r Range("E:F").EntireColumn.Value = "" Range("E1").Resize(nr, 2).Value = Nary End Sub جدول بيانات الشراء1.xlsm

وعليكم السلام-لك ما طلبت بالتنسيقات الشرطية school02.xlsx

وعليكم السلام-تفضل بهذه المعادلة تصل لطلبك =DATEDIF(K8,L8,"y")+DATEDIF(K9,L9,"y")&"years;"&DATEDIF(K8,L8,"ym")+DATEDIF(K9,L9,"ym")&"months;"&DATEDIF(K8,L8,"md")+DATEDIF(K9,L9,"md")&"days" معادلة1 DATEDIF.xlsx

ممتاز استاذ مجدى عمل ممتاز جعله الله فى ميزان حسناتك ورحم الله والديك

أكرمك الله وبارك الله فيك

بعد اذن استاذ سليم ولإثراء الموضوع هذا كود أخر Sub FilterRows() Worksheets("Sheet1").Range("A1").AutoFilter Field:=15, Criteria1:="WATE" End Sub ولحذف او اخفاء الفلترة -يمكنك استخدام هذا الكود Sub TurnOFFAutoFilter() Worksheets("Sheet1").AutoFilterMode = False End Sub المصنف1 .xlsm

وعليكم السلام-بارك الله فيك وزادك الله من فضله

مبروك الأستاذان خيماوى كووول و عبدالله الصارى إنضمامكما لعائلة الخبراء ,أسأل الله لكما التوفيق والنجاح دائما ..وأعانكما الله على هذه المسئولية الجديدة وسدد الله خطاكما عن حق وجدارة بارك الله فيكما وزادكما الله من فضله