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

ممكن عن طريق انشاء مايكرو ميكرو فرعي ثم نحديد الفورم المطلوب احفظ المايكرو باسم AutoExec

ونصيحة ، ابدا لا تستخدم هذه الخاصية في الجدول : . وانما اعمل جدول خاص بقيم هذا الحقل ، ثم في الاستعلام تربط هذا الحقل بحقل الجدول الآخر. لاحظ ان جوابي في المشاركة السابقة لم يتطرق لهذا الحقل ، لأنه لا يوجد طريقة لمعرفة استخدامك لهذه الخاصية إلا بفتح الجدول في وضع التصميم ومعرفة القيم !! عليه ، الدوال يجب تغييرها الى: Function TR_Check(str_N As String) As Boolean If str_N = "^" Or str_N = "#^" Or str_N = "@^" Then TR_Check = True End If End Function Function Type_Check(str_N As String) As Long If IsNumeric(str_N) Or str_N = Chr(34) & "^" & Chr(34) Or str_N = Chr(34) & "*" & Chr(34) Then Type_Check = 1 ElseIf str_N = "@^" Or str_N = "@" Then Type_Check = 2 ElseIf str_N = "^" Then Type_Check = 3 ElseIf str_N = "#^" Or str_N = "#" Then Type_Check = 4 End If End Function جعفر

أولاً اختصار لكود الاضافة Private Sub CommandButton1_Click() Dim LR As Integer Dim i%, bol As Boolean lrow = Sheet2.Range("C" & Rows.Count).End(xlUp).Row LR = WorksheetFunction.CountIf(Sheet2.Range("C4:C" & lrow), TextBox1.Value) If LR >= 1 Then MsgBox "كود الصنف موجود مسبقا" Exit Sub End If For i = 1 To 8 If i = 6 Then i = 7 If Me.Controls("TextBox" & i) = vbNullString Then bol = True MsgBox "You Have Empty textbox" & Chr(10) & _ "I cannot continue" Exit Sub End If Next i If Me.ComboBox6 = vbNullString Then bol = True MsgBox "You Have Empty Combobox" & Chr(10) & _ "I cannot continue" Exit Sub End If If Not bol Then With Sheet2.Range("C" & lrow + 1) For i = 1 To 8 If i = 6 Then i = 7 .Offset(, i - 1) = Me.Controls("TextBox" & i) Me.Controls("TextBox" & i) = vbNullString Next .Offset(, 5) = Me.ComboBox6.Value Me.ComboBox6 = vbNullString End With End If CheckBox1.Value = False MsgBox ("تمت الاضافة") End Sub Atfan.xlsm

انت تكتب الوقت بشكل خاطىء (الصورة) يجب كتابته كما في الخلية D3 من هذا الملف Wask.xlsx

وعليكم السلام-لا تنتظر المساعدة من أحد فالملف خالى تماماً من البيانات ولا يوجد به أصلاً أى فورم والمنتدى كما تعلم تعليمى وليس لتقديم البرامج الجاهزة ... فعليك بتصميم الفورم بنفسك والبدء فى العمل به واذا تعثرت فى جزئية عليك برفعها هنا حتى تتمكن الأساتذة من مساعدتك !!!

أ.جرب المرفق ويارب يشتغل بقى 😁 ملاحظات : فك الملف فى ال D ستجد فولدر اسمه Balance بداخله قاعدة البيانات "Balance" و ملف الإكسيل "Excel_Items.xls" تم تفريغ جدول "tbl_Items" شغل واستورد وطمنى الله يرضي عليك Balance.rar

السلام عليكم بدون احداث افتح اي وحدة نمطية عامة ( module) موجودة في البرنامج عندك والصق السطرين في اعلى الصفحة بشرط يكونوا تحت Option Compare Database Option Explicit ويمكن تجد فقط Option Compare Database

وعليكم السلام-يمكنك استخدام هذه المعادلة =IF($N5="","",OFFSET($B$4,MATCH($O5,$B$5:$B$13,0),MATCH($N5,$C$4:$L$4,0))) اكثر من شرط في الدالة1.xlsx

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

تم تصميم برنامج الرائد في إدارة مزارع الأرانب الإصدار الأول: بفضلكم تم الإنتهاء من تصميم هذا البرنامج فالرجاء المساعدة في نشره وترويجه بارك الله فيكم وهذا رابط البرنامج https://mega.nz/file/P8YiRbaR#twAa1EmJYr_t1DB-fj7nXpnqKXuHdSN2K1NR167IORs

السلام عليكم 🙂 هذه مشاركتي ، وانا لا احب ان اجعل المعادلات تتزاحم في الاستعلام ، ويُصعب تعديلها لاحقا 🙂 في الاستعلام ، ننادي دالة لقيمة TR ، ودالة اخرى لقيمة Type ، وبما ان القيمتين تعتمدان على قيمة الحقل nom ، فنرسل قيمته الى الدوال : . والنتيجة : . والدوال: Function TR_Check(str_N As String) As Boolean If str_N = "^" Or str_N = "#^" Or str_N = "@^" Then TR_Check = True End If End Function Function Type_Check(str_N As String) As String If IsNumeric(str_N) Or str_N = Chr(34) & "^" & Chr(34) Or str_N = Chr(34) & "*" & Chr(34) Then Type_Check = "[1 (مسند)]" ElseIf str_N = "@^" Or str_N = "@" Then Type_Check = "[2 (موقوف)]" ElseIf str_N = "^" Then Type_Check = "[3 (طريق)]" ElseIf str_N = "#^" Or str_N = "#" Then Type_Check = "[4 (زائد)]" End If End Function . ويمكنك ان تأخذ معادلات الاستعلام ، وتضعها في استعلام تحديث 🙂 جعفر 1350.MZtab.accdb.zip

غير معيار التصفية إلى الكود التالي Like '"*"' Or '"^"' Or >="0"

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

جزاك الله خيراً أخي الحبيب أبو عاصم، وجعل ذلك في صحيفة أعمالك 🙂

اعمل Backup يومى للجداول ولو حدثت مشكلة اعمل استعادة لليوم السابق مثلا .. وما اكثر المواضيع فى المنتدى تتحدث عن النسخ الاحتياطى للجداول ابحث وستجد الكثير .. بالتوفيق

حبيبنا الأستاذ شحادة، أنار الله قلبك.. لا يخفى عليكم صعوبة ترتيب الشعر، ولما كان هذا الأمر كذلك، أعددت ماكرو يقرب المسألة بشكل كبير جدا، فيرتب الأبيات على الحرف الأخير وعلى ما قبله أيضا، وراعيت فيه عدم اعتبار (ا ، و ، ى) في ترتيب القواف، فكانت النتيجة مرضية إلى حد كبير. لذا رأيت أن أعرض عليك الماكرو، لما لك من خبرة في هذا المجال، ويمكن أن تضيف خاصية ترتيب الشعر إلى الإضافة، والشرط في هذا الماكرو: 1- أن يكون الشطران موجودين. 2- عدم وجود أي شيء إلا الجدول. 3- عدم وجود مسافة قبل الشطر الأول. 4- يكون الشطر الأول والثاني في حقلين متصلين، يعني لا يكون بينهما فاصل. وهذا هو الماكرو: Sub شعر3() ' ' شعر3 Macro 'ماكرو ترتيب أبيات شعرية ضمن جدول مكون من أربع حقول، بشرط عدم وجود أي شيء إلا الجدول، مع عدم وجود مسافة قبل الشطر الأول ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Font.Hidden = True With Selection.Find .Text = "[\؟\!:\)\(\»]" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With For i = 1 To 1000 Selection.Find.Execute replace:=wdReplaceAll Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend Selection.Copy Selection.HomeKey Unit:=wdRow, Extend:=True Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="××" Selection.PasteAndFormat (wdPasteDefault) Selection.MoveLeft Unit:=wdWord, Count:=1 Selection.TypeBackspace Selection.HomeKey Unit:=wdLine Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend If Selection.Font.Underline = wdUnderlineNone Then Selection.Font.Underline = wdUnderlineSingle Else Selection.Font.Underline = wdUnderlineNone End If Selection.Find.ClearFormatting Selection.Find.Font.Underline = wdUnderlineSingle Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[ًٌٍَُِّْ]" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute replace:=wdReplaceAll Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=3 Selection.HomeKey Unit:=wdLine, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Cut Selection.MoveRight Unit:=wdWord, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.PasteAndFormat (wdPasteDefault) Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Cut Selection.HomeKey Unit:=wdLine Selection.PasteAndFormat (wdPasteDefault) Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, name:="" Selection.Find.ClearFormatting Selection.Find.Font.Underline = wdUnderlineSingle With Selection.Find .Text = "[ًٌٍَُِّْ]" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With If Selection.EndKey = fals Then Exit For End If Next i Selection.Tables(1).Select Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _ True Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^pا" .Replacement.Text = "^p" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^pو" .Replacement.Text = "^p" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^pى" .Replacement.Text = "^p" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll Selection.WholeStory Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend WordBasic.TextToTable ConvertFrom:=1, NumColumns:=4, NumRows:=27, _ InitialColWidth:=wdAutoPosition, Format:=0, Apply:=1184, AutoFit:=1, _ SetDefault:=0, Word8:=0, Style:="شبكة جدول" Selection.HomeKey Unit:=wdStory Selection.Sort ExcludeHeader:=False, FieldNumber:="عمود 1", SortFieldType _ :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, FieldNumber2 _ :="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _ wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _ wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _ wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _ :=wdArabic, SubFieldNumber:="فقرات", SubFieldNumber2:="فقرات", _ SubFieldNumber3:="فقرات" Selection.Sort BidiSort:=False, IgnoreThe:=True, IgnoreKashida:=True, _ IgnoreDiacritics:=False, IgnoreHe:=False Selection.HomeKey Unit:=wdStory Selection.RtlPara Selection.Find.ClearFormatting Selection.Find.Font.Underline = wdUnderlineSingle Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Font.Hidden = True Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Font.Hidden = False With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll Selection.WholeStory Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend With Selection.Borders(wdBorderTop) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With Selection.Borders(wdBorderLeft) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With Selection.Borders(wdBorderBottom) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With Selection.Borders(wdBorderRight) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With Selection.Borders(wdBorderHorizontal) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With Selection.Borders(wdBorderVertical) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With Selection.Tables(1).AutoFitBehavior (wdAutoFitContent) Selection.Tables(1).AutoFitBehavior (wdAutoFitContent) Selection.MoveUp Unit:=wdLine, Count:=1 MsgBox " تم ترتيب الجدول يا عم الشيخ، تحياتي لفضيلتك" End Sub

محاولة بواسطة دالة لتنفيذ الإستعلامات بواسطة زر على النموذج، MZtab2(1).accdb

وهذا للتأكيد ، اذا بالفعل كنا في نهاية السجلات (EOF) ، اذن اذهب الى بداية السجلات : 'Lsql.MoveFirst If Lsql.EOF Then Lsql.MoveFirst جعفر

جرب هذا الملف Option Explicit Sub Filter_me() Dim Ar(), i%, k% Dim My_rg As Range Dim cret, itm Dim Rs As Worksheet Set Rs = Sheets("رئيسي") i = -1 With Application .ScreenUpdating = False End With Set My_rg = Rs.Range("A1").CurrentRegion If Rs.AutoFilterMode Then My_rg.AutoFilter End If For k = 1 To Sheets.Count If Sheets(k).Name <> Rs.Name Then i = i + 1 ReDim Preserve Ar(i) Ar(i) = Sheets(k).Name End If Next For Each itm In Ar cret = Sheets(itm).Name Sheets(itm).Range("A1").CurrentRegion.Clear My_rg.AutoFilter Field:=10, Criteria1:=cret My_rg.AutoFilter Field:=9, Criteria1:="<>0", _ Operator:=xlAnd My_rg.SpecialCells(2, 23).Copy Sheets(itm).Range("a1").PasteSpecial (8) Sheets(itm).Range("a1").PasteSpecial Next If Rs.AutoFilterMode Then My_rg.AutoFilter End If Rs.Select With Application .ScreenUpdating = True .CutCopyMode = False End With End Sub الملف مرفق Mrgane.xlsm

جال هذا الخطأ في خاطري البارحة بعد ان اغلقت الكمبيوتر ، ونسيته اليوم 😁 اخبرك المشكلة ، والحل: لما تفتح النموذج ، وتشغل الكود ، احنا قلنا للكود: 1. اقرأ البيانات الى نهايتها (EOF (End of File ، 2. بعد ان يقرأ السجل ، ينتقل الى السجل التالي MoveNext ، الى ان يصل الى نهاية البيانات (السجل الاخير) ، ويتم الحاق البيانات ، الآ لما ننقر على زر الحفظ مرة اخرى : 1. يريد ان يقرأ البيانات الى نهايتها ، ولكنه اصلا وصل الى نهايتها من المرة السابقة ، فيتخطى عملية الحفظ ، ولا يحفظ شيء !! اذن ، يجب ان (نضيف هذا السطر) ونخبر الكود: 3. بأن قبل البدأ في عملية الالحاق ، اذهب الى بداية البيانات (السجلات) ، ثم قم بتطبيق الكود 🙂 . جعفر

السلام عليكم اهلاً بك فى المنتدى -بسيطة يمكنك استخدام هذه المعادلة =SUBTOTAL(3,$G$3:$G$1000) 1معادلة اظهار عدد عند عمل فلتر ممكن 500 صف مع 20 جنسية.xlsx

طبعاً

عندي اشتغلت عادي سوف اراجع الملف و اخبرك للتأكد MZtab2(1).accdb

هذا ليس جوابا على سؤالك: فكرة docmd.gotoRecord movenext ثقيلة على البرنامج ، ورجاء تجرب التالي: اعمل نموذج مستمر لجدول فيه 100 او 1000 سجل ، ثم استعمل حلقة For Next وادخل فيها docmd.gotoRecord movenext ، ستجد ان الاكسس توقف عن العمل (طبعا هو شغال ، بس يبين انه مشغول جدا) ، ولا تحصل على رسالى Not Responding اعلى البرنامج !! ومثل ما يقول المثل العماني : الباب اللي يجيك منه ريح ، سدّه واستريح 🙂 جعفر

وعليكم السلام ورحمة الله وبركاته .. تفضل b.accdb

انا لم اعمل اي تعديل على القيم فقط عدلت على خصائص مقطع الصفحات

وعليكم السلام-بسيطة اجعل المعادلة هكذا =IF(OR($A2="",$B2=""),"",DATEDIF($A$2,$B$2,"d")) ‫معادلة حساب تاريخين - 1نسخة.xls

السلام عليكم لا اعلم متى تستغني عن ارقام الصفحات ، فوجوده في اكسس لا معنى له وهي سبب المشكلة تفضل تعديل بسيط على مرفق اخي احمد DATA14.rar

جوابا عن الجزء الأول من السؤال بواسطة استعلام تحديث MZtab.accdb

استاذ احمد الف شكر علي حلك للموضوع واعلمك انني توضلت الي طريقة وجدتها الاسهل لي اطرحها عليك في هذا التعديل a21 ما اطلبه الان من حضرتك ان انقل اجمالي الفاتورة =[Mharkt2]![نص189] بحيث يدخل في حقل to_ta الموجود بالجدول Pu_inv بشكل تلقائي بدون تدخل من المستخدم ويستقر به كبيان بالجدول ولك الف شكر a21.rar

بالتوفيق اخي حسان الحقيقة لم اقم بتنصيب البرنامج ولكن قمت بالاطلاع على محتويات الملف التنفيذي ولدي بعض الملاحظات اتمنى تتقبلها بصدر رحب البرنامج تجريبي لمدة 15 يوم او 15 تسجيل دخول البرنامج يقوم بتغيير دقة الشاشة الى 1024 * 768 وهي دقة منخفضة جدا بالنسبة لقاعدة البيانات استخدمت تسميات عربية لكائنات القاعدة واسماء طويلة والبعض منها متداخل وغير واضح ايضا حقول الجدول باسماء عربية والبعض منها مركب ولم تستخدم ( _ ) للفصل بين الاسماء المركبة لم يتم استخدام البادئة الصحيحة لاسماء الكائنات في جميع الاحوال جهد كبير ومقدر مع تمنياتي لك بالتوفيق وان يجد برنامجك القبول والانتشار المناسب واتمنى تشاهد الموضوع 👇 يحتوى على نصائح مفيدة

وعليكم السلام 🙂 عملت تغيير بسيط في الكود السابق: myTotal_Page_Number = 5 Do until myPage_Number = myTotal_Page_Number myPage_Number = myPage_Number + 1 Docmd.openreport" " acviewnormal Loop اذهب الى اي وحدة نمطية عندك ، واذا ما عندك ، اعمل واحدة ، واكتب التالي في اعلى الوحدة النمطية: Option Compare Database Option Explicit اكتب التالي تحت السطر او السطرين اعلاه public myPage_Number as integer public myTotal_Page_Number as integer وفي التقرير اعمل حقلين جدد لترقيم الصفحات: حقل رقم الصفحة التي يتم طباعتها الآن ، وفي مصدر بيانات الحقل اكتب: myPage_Number= حقل مجموع عدد الصفحات التي يتم طباعتها الآن ، وفي مصدر بيانات الحقل اكتب: myTotal_Page_Number= جعفر

جرب هذه المعادلة =IFERROR(LOOKUP(1,0/(Sheet1!$B:$B=$G5)/(Sheet1!$C:$C=$C5),Sheet1!$E:$E),"") m h1.xlsb

عليك برفع الملف الذى يحدث به خطأ معك ... فالملف عندى يعمل بكل كفاءة حتى مع زيادة اى إدخلات جديدة وراجع الملف من فضلك مرة أخرى وهذه هى المعادلة المستخدمة بالتنسيقات الشرطية -مع ضبط تنسيقات اليوم داخل التقويم =MATCH(A5,BSD,0)

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

وعليكم السلام-تفضل لك ما طلبت =CONCATENATE(TEXT(B5,"dddd"),CHAR(10),TEXT(B5,"b2dddd")) 1 Microsoft Excel Worksheet (2).xlsx

فوزى فوزى ولما لم تطلب هذا من البداية وما هو المنطق والفائدة من اهدار وإضاعة وقت الأساتذة دون جدوى أو أهمية ... من فضلك كان عليك رفع طلبك هذا من البداية ؟!!!

وعليكم السلام-تفضل لك ما طلبت بالتنسيقات الشرطية بعد ضبط تنسيق التواريخ بصفحة التقويم Training Plan - Master - Final 2021.xlsx

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

ان قمت بالتدقيق فى الرابط الذى رفعته لك لوجدت طلبك به وهذه هى المعادلة المطلوبة =IFERROR(MID($A3,LEN($A3)-(COLUMNS($B2:B2)-1),1),0)+0 فصل الرقم القومى1.xlsm

ربما تريد هذا الشيء (أفضل من التكرار) wazkr.xlsx

السلام عليكم ورحمة الله ضع هذه المعادلة فى الخلية C28 ثم اضغط Ctrl+Shift+Enter =IFERROR(INDEX($B$2:$D$25;SMALL(IF($B$2:$B$25=$B28;ROW($B$2:$B$25));ROW(A1));2);"") ضع نفس المعادلة فى الخلية D28 و بدل الرقم 2 فى المعادلة السابقة برقم 3 و لا تنسى الضغط على Ctrl+Shift+Enter ايضا و السحب حتى آخر خلية و هكذا مع بقية الجداول

استاذى الفاضل انا شايف ان الملف المصدر مفتوح vba يعنى غير مغلق وايضا الشيتات غير مغلقه يعنى عمليه النقل سهله ! ولا حضرتك مش عايز تتعب تقبل تحياتى