ياسر خليل أبو البراء

وعليكم السلام أخي العزيز محمد ليك وحشة والله .. فينك بقالك فترة مختفي دا حسابي على الفيس للتواصل yakh777@yahoo.com المكتبة التي أعتقد أنك تقصدها موجودة في موضوع بعنوان مكتبة الصرح زاخرة بالشرح ..ابحث عنها وحمل آخر إصدار من آخر المشاركات حيث أنها كانت متجددة تقبل تحياتي

أخي الكريم قم بالدخول لمحرر الأكواد في ملفك عن طريق Alt + F11 قم بنسخ الدالة المعرفة داخل موديول جديد .. احفظ ملفك بامتداد xlsm .. وإن شاء الله تظبط معاك

وعليكم السلام قم بالإطلاع على الرابط التالي الرابط من هنا

وعليكم السلام هل المدخلات بهذا الشكل دائماً أقصد حرف يليه - ثم رقم أم أن هناك توليفات أخرى؟ الأفضل إرفاق ملف معبر عن الطلب

للمزيد حول البدايات قم بالإطلاع على الرابط التالي الرابط من هنا

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات تقبل وافر تقديري واحترامي

وعليكم السلام قم بالإطلاع على الملف بالرابط التالي الرابط من هنا

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

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

وجزيت خيراً أخي الكريم أبو حماده بمثل ما دعوت لي

وعليكم السلام قم بإدراج موديول جديد وضع الدالة المعرفة التالية فيه Function AlphaNum(txt As String, Optional numOnly As Boolean = True) As String With CreateObject("VBScript.RegExp") .Pattern = IIf(numOnly = True, "\D+", "-?\d+(\.\d+)?") .Global = True AlphaNum = .Replace(txt, "") End With End Function ثم في حدث الفورم ضع الكود التالي Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox3.Value = AlphaNum(TextBox1.Value, 0) TextBox2.Value = AlphaNum(TextBox1.Value, 1) End Sub

وجزيت خيراً بمثل ما دعوت لي أخي الكريم تقبل تحياتي

حل المشكلة في الفيديو التالي

وجزيت بمثله أخي الكريم تم تعديل الكود السابق ليناسب طلبك الجديد

وعليكم السلام جرب الكود التالي Sub Test() Dim wsControl As Worksheet Dim wsData As Worksheet Dim wsDB As Worksheet Dim i As Long Dim lrwsData As Long Dim lrwsDB As Long Dim newlr As Long Dim cel As Range Dim rg As Range Application.ScreenUpdating = False Set wsControl = Sheets("Control") Set wsData = Sheets("Data") Set wsDB = Sheets("DB") Set rg = wsDB.UsedRange.Columns(2).Find(CDate(wsControl.[G1].Value2), , xlValues, xlWhole) If Not rg Is Nothing Then MsgBox "Date Existed", vbExclamation: Set rg = Nothing: Exit Sub lrwsDB = wsDB.Cells(Rows.Count, 5).End(xlUp).Row + 1 lrwsData = wsData.Cells(Rows.Count, 4).End(xlUp).Row For i = lrwsData To 2 Step -1 If Len(wsData.Cells(i, 4)) > 0 Then lrwsData = i: Exit For Next i wsData.Range("D2:BG" & lrwsData).Copy wsDB.Range("E" & lrwsDB).PasteSpecial xlPasteValues wsDB.Range("B" & lrwsDB).Value = wsControl.Range("G1").Value wsDB.Range("C" & lrwsDB).Value = wsControl.Range("G2").Value wsDB.Range("D" & lrwsDB).Value = wsControl.Range("G3").Value newlr = wsDB.Cells(Rows.Count, 5).End(xlUp).Row For Each cel In wsDB.Range("A" & lrwsDB & ":A" & newlr) cel.Value = cel.Row - 2 Next cel Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

تشير الى الورقة المطلوبة باستخدام كلمة Sheets يليها قوس مفتوح باستخدام شفت + رقم 9 من الأرقام التي فوق الحروف (ليس من الأرقام في لوحة الأرقام) ثم تفتح قوس " باستخدام شفت + حرف الطاء وتكتب اسم الورقة المراد فك حمايتها ثم تستخدم كلمة Unportect مثال Sheets("Sheet1").Unprotect ثم مسافة ثم كلمة مرور فك الحماية وللحماية مرة أخرى ستستخدم نفس السطر مع استبدال كلمة Unprotect بكلمة Protect

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

جرب الكود التالي Sub SHW_FILS() [a2:a9,c2:c9] = "" Dim strFile As String, StrFiles As String Dim counter As Double, strFileName As String MyFilePath$ = ActiveWorkbook.Path strFile = Dir(MyFilePath$ & "\" & "*.x*") Do While strFile <> "" If strFile <> "log.txt" Then StrFiles = StrFiles & vbCrLf & strFile strFileName = Split(strFile, ".")(0) If IsNumeric(strFileName) Then If counter < Val(strFileName) Then counter = Val(strFileName) Else counter = counter End If ' For str_f = 1 To Len(strFile) ' If Mid(strFile, str_f, 1) Like "*.*" Then ' Num_file = Mid(strFile, 1, str_f - 1) ' Range("a200").End(xlUp).Offset(1) = Num_file ' Range("c200").End(xlUp).Offset(1) = strFile ' End If ' Next str_f strFile = Dir Loop Columns.AutoFit MsgBox counter End Sub

ما المشكلة التي صادفتك أثناء التطبيق؟

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

الحل بسيط وهو أن تقوم بإضافة سطر قبل بداية الكود يقوم بفك حماية الورقة التي سيتم الترحيل إليها وسطر آخر في نهاية الكود لإرجاع الحماية يمكن استخدام Protect و Unprotect .. الموضوع سهل ويسير إن شاء الله

ملف الأخ الكريم توكل يعمل بشكل جيد .. ما المشكلة التي بالملف الآن؟ هل ما زالت مشكلة التاريخ قائمة ؟ أم ماذا تظهر المشكلة لديك بالتحديد الآن؟ حاول توضح المشكلة بالصور لتتضح الصورة أكثر

لا يهم المهم أن تكون نهاة السلسلة تساوي إجمالي عدد الطلاب المطلوب ويمكن بأي طريقة الحصول عليه كما أوضحت

لو تقصد إن رقم آخر صف مش هيكون الإجمالي ممكن تعتمد على أمر آخر وهو قيمة الخلية في آخر صف (أعتقد إن فيه تسلسل من 1 إلى 410 مثلاً) .. فلو كان رقم آخر صف 400 مثلاً : حاجة من الاتنين يا إما تزود 10 على رقم آخر صف عشان توصل لإجمالي الطلاب بالشكل دا For i = 1 To sh.Cells(Rows.Count, 2).End(xlUp).Row + 10 Step 2 يا إما تجيب قيمة الخلية في آخر صف بالشكل دا For i = 1 To sh.cells(sh.Cells(Rows.Count, 2).End(xlUp).Row,1).value Step 2 أو طريقة تالتة إنك تستخدم دالة Countif في محرر الأكواد عشان تعد عدد الطلاب .. كل السبل تؤدي إلى روما ..

تمام الله ينور عليك أخي الكريم ناصر أحسنت