نجوم المشاركات

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

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

وعليكم السلام -تفضل كان عليك استخدام خاصية البحث بالمنتدى تحديد طابعة معينة للطباعة في الكود وهذا فيديو اخر للتوضيح للأستاذة ساجدة العزاوى لها منا كل المحبة والإحترام

لطلبك هذا لابد من استخدام هذه المعادلة =IFERROR(IF(AND(COUNTIF($B$4:B4,B4)=1,U4=0),VLOOKUP($B4,$U$1:$V$2,2,0),IF(AND(COUNTIF($B$4:B4,B4)>1,U4=0),VLOOKUP($B4,$U$1:$V$2,2,0)+(COUNTIFS($B$4:B4,B4,$U$4:U4,U4)-1),"")),"") ترقيم وتسلسل1.xlsx

أخى الكريم تفضل الخطأ كان من عندك انت... فلابد ان تكون ادخالات الوقت صحيحة كصيغة وقت وليست نص بــــ Sheet1 help count late1.xlsx

أخى الكريم لا يوجد مشكلة بالمعادلة فالمشكلة لديك انت عند كتابة الوقت , فاذا كنت تريد كتابة الساعة 01 بعد منتصف الليل فجرب كتابتها هكذا وستجد النتيجة المرجوة 25:00 1.xlsx

الكود من المنتدى لاستاذنا عبدالله باقشير ملف2.xlsb

الاساتذة الافاضل Ali Mohamed Ali حسين مامون ابو يحيى1 سليم حاصبيا ابراهيم الحداد abouelhassan محمد حسن المحمد yara ahmed محمد يوسف فوزى فوزى ashraf_abdalla ابو طيبه بارك الله في الجميع واشكركم جميعا على هذه الثقة وادعو الله ان اكو ن في مستوى المسئولية حفظكم الله جميعا

لا يمكنك التحكم بحقل لوحة المفاتيح اذا كان منضما الى الجدول والحل هو ان تستخدم زر الادخال لنقل النتيجة الى الحقل المحدد انظر التعديل وبعد كتابة الرقم انقر انتر لوحة مفاتيح.rar

في هذه الحالة لا حاجة للفلتر (معادلة بسيطة) Fahd.xlsx

للمرة الــ 100 بعد الألف (يجب ان يكون الجدول مستقلاً عن كل الخلايا التي لا علاقة له بها 1- للمرة الأخيرة اقوم بالمساعدة دون هذه الميزة (تم ادراج صف فارغ لتحقيق ذلك الصف رقم 3 مخفي) الكود Sub Salim_Macro() Application.ScreenUpdating = False Dim My_max% Dim Cont As Integer Dim Ro Cont = Range("H1").Value My_max = Range("A4").CurrentRegion.Rows.Count If My_max = 1 Then GoTo End_Me With Range("A4").CurrentRegion. _ Offset(1).Resize(My_max - 1) _ .Columns(1) .ClearContents .Offset(, 7).ClearContents End With With Range("B4:H" & My_max + 3) .Sort .Columns(4), xlAscending, Header:=1 .Sort .Columns(3), xlAscending, Header:=1 .Sort .Columns(6), xlDescending, Header:=1 End With Range("a5").Resize(My_max - 1) = _ Evaluate("Row( 1:" & My_max - 1 & ")") Range("H5").Resize(My_max - 1).Formula = _ "=INT((ROWS($A$1:A1)-1)/" & Cont & ")+1" Range("A4:H" & My_max).Value = _ Range("A4:H" & My_max).Value End_Me: Application.ScreenUpdating = True End Sub الملف مرفق Moustsfa_Sort.xlsm

جرب الماكرو هكذا ربما يفي بالغرض Sub Macro1() Application.ScreenUpdating = False Dim Cont As Integer Dim lr Cont = Range("h1").Value lr = Range("b" & Rows.Count).End(xlUp).Row With Range("b4:h" & lr) .Sort .Columns(4), xlAscending .Sort .Columns(3), xlAscending .Sort .Columns(6), xlDescending End With With Range("h4:h" & lr) .FormulaR1C1 = "=MOD(ROW()-4," & Cont & ")+1" .Value = .Value End With With Range("b4:h" & lr) .Sort .Columns(7), xlAscending End With Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله جرب هذا الكود Sub GetName() Dim ws As Worksheet, Arr As Variant Dim LR As Long, i As Long Dim j As Long, x As Long Application.ScreenUpdating = False Set ws = Sheets("ورقة2") LR = ws.Range("A" & Rows.Count).End(3).Row Arr = ws.Range("A13:AA" & LR).Value x = 3 Do While x <= 27 For i = 1 To UBound(Arr, 1) For j = 1 To UBound(Arr, 2) If ws.Cells(1, x) = Arr(i, j) Then ws.Cells(2, x) = Arr(i, 1) End If Next Next x = x + 1 Loop Application.ScreenUpdating = True End Sub

الف مبروك تستاهلوا كل خير وفقكم الله واعانكم

السلام عليكم ورحمة الله الف الف مبروك مزيد من التقدم و النجاح ان شاء الله

تفضل لك كل ما طلبت حسابات العملاء 1.xlsx

وعليكم السلام-اهلا بك فى المنتدى -تفضل لك ما طلبت المصنف1 1.xlsx

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

تفضل Convert exe to xls

وعليكم السلام -يمكن جعل الأكواد هكذا Private Sub Option2_Click() If Option2.Visible = True Then frm1.Hide Sheets("Ý.1.Ë.Ú").Visible = True Sheets("Ý.1.Ã").Visible = False Sheets("Ý.1.Ë.Ã").Visible = False End If End Sub Private Sub Option1_Click() If Option1.Visible = True Then frm1.Hide Sheets("Ý.1.Ã").Visible = True Sheets("Ý.1.Ë.Ú").Visible = False Sheets("Ý.1.Ë.Ã").Visible = False End If End Sub Private Sub Option3_Click() If Option3.Visible = True Then frm1.Hide Sheets("Ý.1.Ë.Ã").Visible = True Sheets("Ý.1.Ã").Visible = False Sheets("Ý.1.Ë.Ú").Visible = False End If End Sub التنقل بين الصفحات.xlsb

تسلم ايدك ياغالى هو ده المطلوب والف مليون على الترقيه تستحقها عن جدارة

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

فى مشكلة فى المرفق ولاحظ كلمة Unavailable

الحل كما ارفقت لحضرتك انك كنت مش معرف زر choise فى الجدول Table1 انا ضفته فى الجدول والاستعلام وهكذا تقدر تتعامل مع البيانات بالتوفيق اخى وانا تحت امرك فى اي معلومه تريدها

من كنوز المنتدي اتمنى ان يكون فيه طلبك التفقيط بالجنية والقروش (1).xlsm

اتفضل التعديل ويمكن الاختيار اكثر من سجل tester.rar

جرب هذا الكود Option Explicit Sub filter_me() Dim T As Worksheet Dim S As Worksheet Dim Rg As Range Dim Ro Dim cret$ Set S = Sheets("Source") Set T = Sheets("Target") Set Rg = S.Range("E2").CurrentRegion S.AutoFilterMode = False T.Range("E2").CurrentRegion.Clear cret = T.Range("A1") Rg.AutoFilter 3, cret Rg.SpecialCells(12).Copy With T.Range("E2") .PasteSpecial (4) .PasteSpecial (12) End With S.AutoFilterMode = False Application.CutCopyMode = False Ro = T.Range("E2").CurrentRegion.Rows.Count If Ro > 1 Then T.Range("E3").Resize(Ro - 1) = _ Evaluate("Row(1:" & Ro - 1 & ")") End If T.Range("E2").Select End Sub الملف مرفق f16.xlsm

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

لا بمكن جذف خلية (أو أكثر ) منفردين من الأكسل ) ماذا ستضع مكانها ؟؟؟ لقاح لفيروس كورونا مثلاً لذلك هناك خياران: 1- أمّا ان تجذف صف (أو عدة صفوف )بكاملها 2- أمّا عامود ( أو عدة اعمدة ) بكاملها

الطريقة الاخرى بدون التعديل على مصدر السجلات للتقرير نقوم بانشاء لستعلام صغير لغرض التخلص من القيم الفارغة قيمته تساوي SELECT Employee.Status, Employee.Dept, Nz([Status],"حاضر") AS status2 FROM Employee; وفي حقل عدد الحضور نضع التعبير =DCount("[Dept]";"q_2";"[dept]='" & [Dept] & "'" & "and status2 <>'غائب'") الملف مرفق Employees.accdb

الشكر لله اخي الطريقة اننا قمنا بعد سجلات الجدول باستخدام دالة DCount عن طريق شرطين الاول ان يكون القسم يساوي القسم والشرط الثاني ان يكون حقل الحالة فارغ لكن لدي سؤال ادريا من خرج من العمل باذن لا يعتبر غائب عن العمل و لو اردنا اعتبار باذن من ضمن الحضور حينها سنجد ان الطريقة لن تعمل بشكل صحيح وسوف نستخدم طريقتين اخرى سوف ارفقها لك ولكل من قد يجد المثال نافعا الطريقة الاولى بان نجعل مصدر التقرير استعلام ونعمل فيه حقل محسوب قيمته تساوي وبالتالي يتم تسجيل عبارة حاضر بشكل تلقائي في التقرير اذا كان حقل الحالة فارغ Status2: Nz([Status];"حاضر") في حقل عدد الحضور في التقرير نجعل قيمته تساوي =DCount("*";"q_1";"[dept]='" & [Dept] & "'" & "and status2 <>'غائب'") وتفسيرة قم بعد الحقول في الاستعلام اذا كان القسم يساوي القسم وحالة الموظف لا تساوي غائب والنتيجة Employees1.accdb

كاسم المستلم مثلا او المستلم + المشروع معا لم أر المستلم ولا المشروع في الجدول فهل المستلم هو المستفيد والمشروع هو الموقع ام بالعكس جرب هذا الملف (صفحة One For_All ) الملف مرفق Option Explicit Dim DC As Object Dim DD As Object Dim D_Sh As Object Dim O As Worksheet Dim sh As Worksheet Dim i, Max_ro%, m% '++++++++++++++++++++++++++++++ Private Sub Worksheet_Activate() data_val End Sub '++++++++++++++++++++++++++ Sub MY_choose() Select Case Sheets("One For_All").Range("G2") Case "E": Filter_Only_E Case "D": Filter_Only_D Case "D+E": Filter_C_And_D Case Else: Exit Sub End Select End Sub '++++++++++++++++++++ Sub data_val() Set O = Sheets("One For_All") Set DC = CreateObject("Scripting.Dictionary") Set DD = CreateObject("Scripting.Dictionary") Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row For i = 2 To Max_ro DC(Sheets("Payments").Cells(i, "C").Value) = vbNullString DD(Sheets("Payments").Cells(i, "D").Value) = vbNullString Next With O.Range("D2").Validation .Delete .Add 3, Formula1:=Join(DC.keys, ",") End With With O.Range("E2").Validation .Delete .Add 3, Formula1:=Join(DD.keys, ",") End With End Sub '+++++++++++++++++++++++++++ Sub Filter_Only_E() Set O = Sheets("One For_All") If O.Range("C4").CurrentRegion.Rows.Count > 1 Then O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion. _ Rows.Count - 1).Clear End If Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row m = 5 If O.Range("E2") = vbNullString Then Exit Sub For i = 2 To Max_ro If Sheets("Payments").Cells(i, "D") = O.Range("E2") Then O.Cells(m, 3) = m - 4 O.Cells(m, 4).Resize(, 5).Value = _ Sheets("Payments").Cells(i, 2).Resize(, 5).Value m = m + 1 End If Next If O.Range("C4").CurrentRegion.Rows.Count > 1 Then With O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .Interior.ColorIndex = 35 .InsertIndent 1 End With End If End Sub '+++++++++++++++++++++++++++++++++++ Sub Filter_Only_D() Set O = Sheets("One For_All") If O.Range("C4").CurrentRegion.Rows.Count > 1 Then O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion. _ Rows.Count - 1).Clear End If Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row m = 5 If O.Range("D2") = vbNullString Then Exit Sub For i = 2 To Max_ro If Sheets("Payments").Cells(i, "C") = O.Range("D2") Then O.Cells(m, 3) = m - 4 O.Cells(m, 4).Resize(, 5).Value = _ Sheets("Payments").Cells(i, 2).Resize(, 5).Value m = m + 1 End If Next If O.Range("C4").CurrentRegion.Rows.Count > 1 Then With O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .Interior.ColorIndex = 35 .InsertIndent 1 End With End If End Sub '++++++++++++++++++++ Sub Filter_C_And_D() Set O = Sheets("One For_All") If O.Range("C4").CurrentRegion.Rows.Count > 1 Then O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion. _ Rows.Count - 1).Clear End If Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row m = 5 If O.Range("D2") = vbNullString Or _ O.Range("E2") = vbNullString Then Exit Sub For i = 2 To Max_ro If Sheets("Payments").Cells(i, "C") = O.Range("D2") And _ Sheets("Payments").Cells(i, "D") = O.Range("E2") Then O.Cells(m, 3) = m - 4 O.Cells(m, 4).Resize(, 5).Value = _ Sheets("Payments").Cells(i, 2).Resize(, 5).Value m = m + 1 End If Next If O.Range("C4").CurrentRegion.Rows.Count > 1 Then With O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .Interior.ColorIndex = 35 .InsertIndent 1 End With End If End Sub Hisabat_Super.xlsm

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

جرب هذا الكود اذا لم تظهر القائمة المنسدلة (في الشيت Result) غادر الصفجة ثم عد اليها مجدداً Ihab.xlsm

البقاء والدوام لله اللهم اغفر له واجعل مثواه الجنة واجعل قبره روضة من رياض الجنان واجعله من منزلة المرسلين والشهداء اللهم الهم اهله وذويه الصبر والسلوان

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

تفضل وبما انك لم تقم برفع ملف للمطلوب فعليك بمشاهدة هذه الفيديوهات فبها طلبك -بارك الله فيك تجميع وتلخيص اكثر من ورقة في ورقة واحدة اكسل Excel Consolidate وكيفية دمج داتا اكثر من شيت اكسيل في شيت واحد

الأمر بكل بساطة كان عليك عمله بنفسك وتزويد من تريد من النطاق بالمعادلة ... وعليك ان تعلم ما حدث معك من خطأ بسببك انت لأن هذه معادلة مصفوفة وليس معادلة عادية فيجب عليك بعد عمل المعادلة الضغط على (Ctrl+Shift+Enter) وليس Enter فقط كباقى المعادلات moooo2.xlsx

وعليكم السلام وبما انك لم تقم برفع ملف فكان عليك استخدام خاصية البحث بالمنتدى فبه طلبك تفضل فورم اضافة وبحث وحذف وتعديل واغلاق وطباعة بدون ازرار أويمكنك متابعة هذا الفيديو فبه طلبك طباعة الفورم userform مع اخفاء الازرار vba excel - commandbutton

بعد اذن الأستاذ سـلـيم وزيادة فى اثراء الموضوع بدون اخفاء شريط الصيغة ... يمكنك وضع هذا الكود فى حدث الصفحة Dim xDic As New Dictionary Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim xCell As Range Dim xRg As Range Set xRg = Range("b2:b100") If xDic.Count <> xRg.Count Then For Each xCell In xRg xDic.Add xCell.Address, xCell.FormulaR1C1 Next End If If (Target.Count = 1) And (Not Application.Intersect(xRg, Target) Is Nothing) And (Target.HasFormula) Then With Target .Value = .Value End With Else For Each xCell In xRg xCell.Formula = xDic.Item(xCell.Address) Next End If End Sub

بارك الله فيك وزادك الله من فضله ورحم الله والديك

تفضل بعد اذن الأستاذ سليم طبعاً يمكنك عملها بنفسك بهذه المعادلة =SUMIFS('1'!$D$4:$D$270,'1'!$B$4:$B$270,">="&$F$5,'1'!$B$4:$B$270,"<="&$H$5,'1'!$C$4:$C$270,$B7,'1'!$A$4:$A$270,$D$6)

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

وعليكم السلام -اهلا بك اخى الكريم فى المنتدى لماذا لا تستخدم خاصية البحث فى المنتدى -يمكنك هذا بعد اضافة أداة Solver وطالما انك لم تقم برفع ملف فيمكنك متابعة ومشاهدة هذه المشاركة بها رد لما تحتاجه https://www.officena.net/ib/topic/85879-معادلة-جمع-بعض-الارقم-التى-تحقق-ناتج-معين/?tab=comments#comment-544482 بارك الله فيك

بارك الله فيك استاذ سليم وبعد اذن حضرتك ولإثراء الموضوع -يمكن أيضاً استخدام هذه المعادلة بداية من الخلية N3 سحباً يساراً وأسفل =COUNTIFS($H$3:$H$500,"<="&$M3,$H$3:$H$500,">="&$L3,$I$3:$I$500,N$2) Countifs,معادلة احصاء عدد الذكور والإناث بين تاريخين.xlsx

تفضل لك ما طلبت ... وذلك لوجود مسافات زائدة بالمعادلة , تم حذفها ,ورجاءاً لابد ان تكون نهايات فورمات الملف XLSX وليس XLS محمد4.xlsx

تفضل ولكن كان عليك رفع ملف موضح عليه المطلوب بكل دقة المستخدم (المدير) الباسورد (1) وهذا برنامج أخر موجود داخل المنتدى ... كان عليك استخدام خاصية البحث بالمنتدى هدية - برنامج تقسيط وهذا برنامج ثالث , أيضاً من داخل المنتدى الرجاء المساعدة في برنامج البيع بالتقسيط وتلك برنامج رابع أسفل فيديو الشرح برنامج المحل شراء وبيع وتقسيط اكسس Access برنامج البيع بالتقسيط 2009.rar

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

وعليكم السلام-اجعل المعادلة هكذا =IF(A2="","",NETWORKDAYS.INTL(A2,TODAY(),7)) 1تاريخ البدء.xlsx

وعليكم السلام-تفضل ما تريد بالتنسيقات الشرطية. وتم ايضاً لعمل قائمة منسدلة لإختيار الحروف المطلوبة نظام التقييم للصف االاول بالألوان1.xlsx