عبدالله بشير عبدالله

وفيك بارك الله ,اعلم ذلك والا ما قمت انت والاستاذ محمد صالح يكفى وزيادة لك وافر التقدير الاحترام

يفترض فتح موضوع جديد ولكن بما انه نفس الملف مع تعديل في نفس الكود ذكور ثم انات.xlsb

السلام عليكم ورحمة الله وبركاتة تحياتى للاستاتذة الافاضل محمد صالح ومحمد هشام و حسين التجدى اعتقد ان صاحب الموضوع لم يكن طلبه الذكور في عمود والاناث في العمود المقابل بل بربد المزج بينهما في نفس العمود اول اسم ذكر الصف الذي يليه انثى وهكذا وهذا ما فهمته من ملفه المرفق حيث يوجد في طلبه الذكور في صف والاناث في صف على كل حال اذا كان فهمى للموضوع صحيحا فالكود التالى يلبى الطلب ان شاء الله وان كان فهمى للامر غير ذلك فعذرا من الجميع الكود Sub TransferStudentsByGenderAlternate22() Dim wsData As Worksheet Dim wsList As Worksheet Dim lastRow As Long Dim selectedClass As String Dim i As Long Dim rowMale As Long, rowFemale As Long Dim maleList As Collection, femaleList As Collection Dim studentName As String Dim studentGender As String Dim studentData As String Dim maxRows As Long Dim lastNumber As Long Dim currentNumber As Long Set wsData = ThisWorkbook.Sheets("قاعدة البانات") Set wsList = ThisWorkbook.Sheets("قوائم الفصول") selectedClass = wsList.Range("D5").Value lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).row Set maleList = New Collection Set femaleList = New Collection For i = 8 To lastRow If wsData.Cells(i, 3).Value = selectedClass Then ' التحقق من الفصل studentName = wsData.Cells(i, 2).Value studentGender = wsData.Cells(i, 4).Value studentData = wsData.Cells(i, 13).Value ' العمود M If studentGender = "ذكر" Then maleList.Add Array(studentName, studentData) ElseIf studentGender = "انثى" Then femaleList.Add Array(studentName, studentData) End If End If Next i rowMale = 7 rowFemale = 8 maxRows = 34 wsList.Range("B7:F40").ClearContents For i = 1 To Application.WorksheetFunction.Max(maleList.Count, femaleList.Count) If rowMale <= 40 Then If i <= maleList.Count Then wsList.Cells(rowMale, 2).Value = maleList(i)(0) wsList.Cells(rowMale, 3).Value = maleList(i)(1) rowMale = rowMale + 2 End If If i <= femaleList.Count And rowFemale <= 40 Then wsList.Cells(rowFemale, 2).Value = femaleList(i)(0) wsList.Cells(rowFemale, 3).Value = femaleList(i)(1) rowFemale = rowFemale + 2 End If ElseIf rowMale > 40 Then If i <= maleList.Count Then wsList.Cells(rowMale - 34, 5).Value = maleList(i)(0) wsList.Cells(rowMale - 34, 6).Value = maleList(i)(1) rowMale = rowMale + 2 End If If i <= femaleList.Count Then wsList.Cells(rowFemale - 34, 5).Value = femaleList(i)(0) wsList.Cells(rowFemale - 34, 6).Value = femaleList(i)(1) rowFemale = rowFemale + 2 End If End If Next i currentNumber = 1 For i = 7 To 40 If wsList.Cells(i, 2).Value <> "" Then wsList.Cells(i, 1).Value = currentNumber currentNumber = currentNumber + 1 End If Next i For i = 7 To 40 If wsList.Cells(i, 5).Value <> "" Then wsList.Cells(i, 4).Value = currentNumber currentNumber = currentNumber + 1 End If Next i End Sub الملف Microsoft Excel Worksheet جديد (3).xlsb

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

وعليكم السلام ورحمة الله وبركاته نعم، يمكنك ربط ملف Excel بملف Access عند عمل تحديث بيانات أو اضافة في ملف اكسل تنتقل هذه االتحديثات أو الاضافات أو التغييرات الى ملف اكسس اتبع الخطوات في الصور قاعدة بيانات.zip اكسل.xlsm

احد المواقع افادتي بالاني :- عندما تقوم بتنزيل ملف Excel من OneDrive وتحفظه على جهازك كملف محلي، فإن ارتباطه بالملف الأصلي على OneDrive سينقطع. يعني أن أي تغييرات تطرأ على الملف الموجود على OneDrive لن تنعكس في النسخة التي قمت بتنزيلها على جهازك. الحفاظ على الارتباط بالملف الأصلي على OneDrive للإبقاء على الارتباط بالملف الأصلي الموجود على OneDrive، يمكنك اتباع الطرق التالية: استخدام رابط المشاركة: بدلاً من تحميل الملف، يمكنك استخدام رابط المشاركة المباشر للملف في OneDrive. هذا سيمكنك من ربط الجدول في Access مباشرةً دون الحاجة لتنزيله. يمكنك استخدام الرابط كما يلي: في Access، عند إنشاء جدول مرتبط، أدخل رابط المشاركة مباشرة في مربع اسم الملف. تأكد من أن الرابط يؤدي مباشرةً إلى الملف (يجب أن يكون رابط التحميل وليس رابط العرض). مزامنة المجلد المشترك: كما ذكرت سابقًا، يمكنك إضافة المجلد المشترك إلى OneDrive الخاص بك، مما يسمح لك بمزامنة المحتويات مع جهاز الكمبيوتر. بمجرد إضافة المجلد، سيظهر في مجلد OneDrive المحلي، وسيظل مرتبطًا بالملف على OneDrive. إذا تم تحديث الملف على OneDrive، فإن النسخة المحلية ستتزامن تلقائيًا. خلاصة إذا قمت بتحميل الملف: الارتباط سيفقد، وأي تغييرات على OneDrive لن تؤثر على النسخة التي لديك محليًا. إذا استخدمت رابط المشاركة أو مزامنة المجلد: ستحافظ على الارتباط، وأي تغييرات في الملف على OneDrive ستظهر تلقائيًا في Access. إذا كنت بحاجة إلى الحفاظ على الارتباط، فالأفضل هو استخدام رابط المشاركة أو مزامنة المجلد موقع اخر افادني للأسف، بعد تنزيل الملف من OneDrive إلى جهاز الكمبيوتر، لن يبقى مرتبطًا تلقائيًا بملف Excel الأساسي الموجود على OneDrive. ستحتاج إلى إعادة إنشاء الرابط يدويًا بعد تنزيل الملف. إليك كيفية القيام بذلك: فتح الملف الذي تم تنزيله: افتح ملف Excel الذي قمت بتنزيله على جهاز الكمبيوتر. إعادة إنشاء الرابط: اذهب إلى علامة التبويب “بيانات” (Data) في Excel. اختر “تحرير الروابط” (Edit Links) من مجموعة “الاتصالات” (Connections). في نافذة “تحرير الروابط”، اختر الرابط الذي تريد تحديثه، ثم انقر على “تغيير المصدر” (Change Source). حدد ملف Excel الأساسي الموجود على OneDrive كمصدر جديد. حفظ التغييرات: بعد تحديث الروابط، احفظ الملف. بهذه الطريقة، ستتمكن من الحفاظ على الروابط بين الملفات حتى بعد تنزيلها. إذا كنت بحاجة إلى مزيد من المساعدة أو لديك أي استفسارات أخرى، لا تتردد في طرحها! 😊 1: Fix broken links to data - Microsoft Support 2: Problem with excel workbook links on onedrive - Microsoft Community

نعم لديك كل الحق نم التعديل في المشاركة السابقة

وعليكم السلام ورحمة الله وبركاته بعد اذن الاستاذ حجازى واثراءا للموضوع واظافة وهي عدم السماح للصف الذي به بيانات باظافة صف فارغ الا مرة واحدة الكود Private Sub CommandButton1_Click() Dim i As Long Dim ws As Worksheet Dim lastRow As Long Dim nextRowData As Long Set ws = ActiveSheet Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False lastRow = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _ SearchFormat:=False).Row For i = lastRow To 2 Step -1 If Application.WorksheetFunction.CountA(ws.Rows(i)) > 0 Then nextRowData = Application.WorksheetFunction.CountA(ws.Rows(i + 1)) If nextRowData > 0 Then ws.Rows(i + 1).Insert Shift:=xlDown End If End If Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub الملف إضافة صف فارغ.xlsm

قدمت له استفسارك فاجابنى لإدخال جداول من ملف Excel الموجود في OneDrive كمصدر مرتبط في Microsoft Access، يمكنك اتباع الخطوات التالية: 1. الحصول على رابط المشاركة للملف: قم بفتح OneDrive عبر المتصفح. اذهب إلى الملف الذي شارك به صديقك. انقر على زر المشاركة (Share) واختر "نسخ الرابط" (Copy link) ليكون لديك رابط مباشر للملف. 2. تحميل الملف إلى جهاز الكمبيوتر: نظرًا لأن الملف لا يظهر في مجلد OneDrive على الكمبيوتر، يمكنك تحميله مباشرةً من الرابط الذي حصلت عليه. افتح الرابط في المتصفح. قم بتحميل الملف على جهاز الكمبيوتر. 3. استيراد الجداول إلى Access: افتح Microsoft Access. أنشئ قاعدة بيانات جديدة أو افتح قاعدة بيانات موجودة. اذهب إلى علامة التبويب "خارج البيانات" (External Data). اختر "Excel" من مجموعة استيراد & ربط. في مربع الحوار الذي يظهر، اختر "ربط إلى المصدر" (Link to the data source by creating a linked table). ابحث عن ملف Excel الذي قمت بتحميله، وحدده. اتبع التعليمات لإكمال عملية الربط. اختر الجداول التي ترغب في ربطها. 4. تأكيد الربط: بعد الانتهاء من عملية الربط، ستظهر الجداول في Access كجداول مرتبطة، ويمكنك استخدامها كما لو كانت جداول محلية.

المشكلة في الفراغات وبما ان الترقيم به ارقام ونصوص فيكون التنسيق نص كما تم وضع كود لازالة الفراغات الدالة =IFERROR(VLOOKUP(P5; 'صفحه البيانات'!$E$2:$F$10000; 2; FALSE); "غير موجود") الملف شرح الاسباب (1).xlsx

الملف السابق به تعديل المدى في الشيتات الثلاتة الاولى الكود السابق يبذأ من الصف 12 والصحيح انه 9 على كل حال الملف المرفق الحالى به زرين الاول الكود الاول مع التعديل والزر الاخر الكود بالمصفوفة وكلاهما سريعين جدا ترحيل الدرجات1.xlsm

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

وعليكم السلام ورحمة الله وبركاته حسب فهمي لطلبك الكود Sub FilterAndCopyData() Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, wsDest As Worksheet Dim searchValue As String Dim rng As Range, cell As Range Dim lastRow As Long, destRow As Long Dim serialNumber As Long Set ws1 = ThisWorkbook.Sheets("SHEET1") Set ws2 = ThisWorkbook.Sheets("SHEET2") Set ws3 = ThisWorkbook.Sheets("SHEET3") Set wsDest = ThisWorkbook.Sheets("SAAD") wsDest.Range("C13:R" & wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Row).ClearContents searchValue = wsDest.Range("N7").Value destRow = 13 serialNumber = 1 For Each ws In Array(ws1, ws2, ws3) lastRow = ws.Cells(ws.Rows.Count, "P").End(xlUp).Row Set rng = ws.Range("P12:P" & lastRow) For Each cell In rng.Cells If cell.Value = searchValue Then wsDest.Cells(destRow, "C").Value = serialNumber wsDest.Cells(destRow, "F").Value = cell.Offset(0, -10).Value wsDest.Cells(destRow, "J").Value = cell.Offset(0, -6).Value wsDest.Cells(destRow, "L").Value = cell.Offset(0, -4).Value wsDest.Cells(destRow, "M").Value = cell.Offset(0, -3).Value wsDest.Cells(destRow, "P").Value = cell.Value wsDest.Cells(destRow, "Q").Value = cell.Offset(0, 1).Value wsDest.Cells(destRow, "R").Value = cell.Offset(0, 2).Value destRow = destRow + 1 serialNumber = serialNumber + 1 End If Next cell Next ws End Sub الملف ترحيل الدرجات1.xlsm

تفضل شرح الكود اما اذا تم اظافة اعمدة فربما شرح الكود بقيدك بطريقة التعديل او يمكنك حينها فنح موضوع جديد بالمنتدى وتقديم سؤالك بالتوفيق Private Sub Worksheet_Change(ByVal Target As Range) ' تعريف المتغيرات Dim wsRes As Worksheet ' ورقة العمل "res" Dim wsMokata As Worksheet ' ورقة العمل "mokata" Dim districtNumber As String ' الرقم المدخل في العمود F Dim lastRowMokata As Long ' آخر صف يحتوي على بيانات في عمود A في ورقة "mokata" Dim dataRange As Range ' النطاق الذي سيتم البحث فيه عن الرقم المدخل Dim foundCount As Integer ' عداد لعدد المرات التي يظهر فيها الرقم المدخل Dim cell As Range ' متغير ليمثل كل خلية في نطاق البحث ' ربط المتغيرات بأوراق العمل Set wsRes = ThisWorkbook.Sheets("res") Set wsMokata = ThisWorkbook.Sheets("mokata") ' يتم تجاهل الأخطاء لمنع تعطل الكود في حال حدوث خطأ On Error Resume Next ' التحقق مما إذا كانت الخلية التي تم تغييرها هي في العمود F من ورقة "res" If Not Intersect(Target, wsRes.Range("F:F")) Is Nothing Then districtNumber = Trim(CStr(Target.Value)) ' الحصول على الرقم المدخل مع إزالة المسافات الفارغة 'f اً إذا تم مسح الخلية في العمود، يتم مسح المحتويات في الأعمدة المجاورة (G, H, I) If districtNumber = "" Then Target.Offset(0, 1).Resize(1, 3).ClearContents Else ' تحديد آخر صف يحتوي على بيانات في عمود A في ورقة "mokata" lastRowMokata = wsMokata.Cells(wsMokata.Rows.Count, "A").End(xlUp).Row ' تحديد نطاق البحث عن الرقم المدخل Set dataRange = wsMokata.Range("A5:A" & lastRowMokata) foundCount = 0 ' تهيئة عداد المرات التي يظهر فيها الرقم المدخل ' البحث في النطاق عن الرقم المدخل وعدّ المرات التي يظهر فيها For Each cell In dataRange If Trim(CStr(cell.Value)) = districtNumber Then foundCount = foundCount + 1 End If Next cell ' إذا تم العثور على الرقم مرة واحدة فقط If foundCount = 1 Then For Each cell In dataRange ' العثور على الصف الذي يحتوي على الرقم المدخل If Trim(CStr(cell.Value)) = districtNumber Then ' نقل البيانات من الأعمدة 2, 3, 4 في ورقة "mokata" إلى الأعمدة G, H, I في ورقة "res" Target.Offset(0, 1).Value = wsMokata.Cells(cell.Row, 2).Value ' العمود G Target.Offset(0, 2).Value = wsMokata.Cells(cell.Row, 3).Value ' العمود H Target.Offset(0, 3).Value = wsMokata.Cells(cell.Row, 4).Value ' العمود I Exit For ' الخروج من الحلقة بعد العثور على القيمة End If Next cell ' إذا تم العثور على الرقم أكثر من مرة ElseIf foundCount > 1 Then Dim districtList As String ' سلسلة لتخزين القيم المرتبطة بالرقم المدخل districtList = "" ' جمع القيم المرتبطة بالرقم المدخل For Each cell In dataRange If Trim(CStr(cell.Value)) = districtNumber Then districtList = districtList & wsMokata.Cells(cell.Row, 4).Value & "," ' إضافة القيمة إلى السلسلة End If Next cell ' إذا تم العثور على قيم، يتم إعداد واجهة المستخدم (UserForm) لعرض هذه القيم If Len(districtList) > 0 Then districtList = Left(districtList, Len(districtList) - 1) ' إزالة الفاصلة الزائدة في نهاية السلسلة UserForm1.ListBox1.Clear ' مسح القائمة السابقة في ListBox UserForm1.ListBox1.List = Split(districtList, ",") ' تقسيم السلسلة ووضع القيم في ListBox ' ربط الخلية التي تم تغييرها مع النموذج Set UserForm1.TargetCell = Target UserForm1.Show ' عرض النموذج للمستخدم لاختيار قيمة End If Else ' إذا لم يتم العثور على الرقم، يتم عرض رسالة تحذير MsgBox "لا توجد بيانات مرتبطة بهذا الرقم.", vbExclamation End If End If End If End Sub

الاجابة بواسطة الذكاء الاصطناعي يمكنك ربط جداول Excel الموجودة على OneDrive بقاعدة بيانات Access باتباع الخطوات التالية: فتح قاعدة بيانات Access: افتح قاعدة البيانات التي تريد ربط جداول Excel بها. استيراد البيانات من Excel: اذهب إلى علامة التبويب “بيانات خارجية” في شريط الأدوات. اختر “Excel” من مجموعة “استيراد وربط”. تحديد ملف Excel: في نافذة “الحصول على بيانات خارجية - Excel”، انقر على “استعراض” لتحديد ملف Excel الموجود على OneDrive. أدخل مسار الملف أو انسخه من OneDrive. اختيار طريقة الربط: اختر “ربط بمصدر البيانات عن طريق إنشاء جدول مرتبط” ثم انقر على “موافق”. تحديد ورقة العمل: اختر ورقة العمل التي تحتوي على البيانات التي تريد ربطها بقاعدة بيانات Access. إكمال الربط: اتبع التعليمات التي تظهر على الشاشة لإكمال عملية الربط. بهذه الطريقة، ستتمكن من الوصول إلى جداول Excel من داخل Access والعمل عليها كما لو كانت جزءًا من قاعدة البيانات. إ

السلام عليكم اعدرنى على التاخير test (1) (1).xls

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

حسب فهمى للطلب =IF(G3="";"";INT(DATEDIF(G3;TODAY();"m")/4)*10) TESTT.xlsx

تم التعديل test (1).xls

تم التعديل يمكن الاختيار بالفارة ويمكنك الخروج عن طريق علامة × في الفورم test.xls

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

اسعدنى ما قلت , بالتوفيق

السلام عليكم جرب المرفق الاختيار من القائمة بالضغط مرتين على العتصر المختار واذا كان الرقم غير موجود تاتى رسالة بذلك بالتوفيق واي ملاحظات لا حرج في ذلك test.xls

اين تريد النتائج في اي صفحة واي مدى

بالنسبة تكست 18 و19 اذهب الى لوحة التحكم - الساعة والمنطقة - المنطقة - ثم كما بالصورة الملف اظهار نتائج البحث في اللستبوكس1.xlsm