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

وعليكم السلام ورحمه الله وبركاته تفضل Sub Transfer_Non_Adjacent_Columns_Using_Arrays_By_Yasser_Khalil() Dim arr As Variant, i As Variant, cr As Variant, j As Long arr = Sheets("ورقة1").Range("A1").CurrentRegion.Value 'الأعمدة المطلوب الترحيل إليها cr = Array(5, 8, 11, 15, 17, 20) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(1, 2, 3, 4, 5, 6) Sheets("ورقة2").Cells(1, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub

استناداً لفكرة أخي @Abo-Abd Allah ، تم التعديل بشكل بسيط على الكود بحيث يكون البحث داخل النص عن رقم الكتاب وليس ملزماً بموقع الرقم ، أرجو التحقق من النتائج أخي @nssj من الكود التالي :- Function UpdateBooksWithMNO() Dim db As DAO.Database Dim rsBooks As DAO.Recordset Dim rsTab As DAO.Recordset Dim sql As String Dim bookNumber As String Dim found As Boolean Set db = CurrentDb() Set rsBooks = db.OpenRecordset("BOOKS") Do While Not rsBooks.EOF bookNumber = rsBooks!B_Hno found = False sql = "SELECT * FROM TAB WHERE InStr(NASS, '" & bookNumber & "') > 0" Set rsTab = db.OpenRecordset(sql) If Not rsTab.EOF Then rsTab.MoveFirst Do While Not rsTab.EOF If InStr(rsTab!NASS, bookNumber) > 0 Then rsBooks.Edit rsBooks!MNO = rsTab!MNO rsBooks.Update found = True Exit Do End If rsTab.MoveNext Loop End If rsTab.Close Set rsTab = Nothing rsBooks.MoveNext Loop rsBooks.Close Set rsBooks = Nothing Set db = Nothing End Function Smart_Search_function.accdb

إذا حضر الماء بطل التيمم اتفضل خد راحتك يا بروف 😉 😉 كده الاستاذ يعتبر أن مشكلته محلوله إن شاءالله ❤️ ❤️

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

السلام عليكم ورحمة الله وبركاته صبحكم الله بالخير والنور والسرور بارك الله فيكم وفي جهودكم الطيبة أخي الكريم جرب هذا الكود "إن شاء الله يعمل معك" عند التطبيق وجدت اختلاف في قيمة واحدة وهي بالصورة التالية: Public Sub mnoSmartSearch() Dim db As DAO.Database Dim rs As DAO.Recordset Dim tabRS As DAO.Recordset Dim sqlStr As String Dim tblName As String Dim foundMno As String Dim totalRec As String Dim exNum As String Dim stext As String Dim sPos As Long Dim startPos As Long Dim endPos As Long Dim i As Long tblName = "BOOKS" If DCount("*", tblName) = 0 Then MsgBox "There are no records in the table " & tblName, vbExclamation + vbOKOnly, "No Records Exist Error" Exit Sub End If Set db = CurrentDb Set rs = db.OpenRecordset(tblName, dbOpenDynaset) With rs .MoveLast .MoveFirst totalRec = .RecordCount Do While Not .EOF sqlStr = "" foundMno = "" If Not IsNull(!BookName) And Not IsNull(!B_Hno) Then sqlStr = "SELECT TAB.MNO, TAB.NASS " & _ "FROM TAB " & _ "WHERE TAB.NASS LIKE '*" & Nz(!BookName, "") & "*' " & _ "AND InStr([NASS],'" & Nz(!B_Hno, "") & "') > 0;" Set tabRS = db.OpenRecordset(sqlStr, dbOpenSnapshot) tabRS.MoveLast tabRS.MoveFirst If tabRS.RecordCount = 0 Then ' No Results found Debug.Print "NotFound", !BookName, !B_Hno ElseIf tabRS.RecordCount = 1 Then ' One Result Found and that what we want foundMno = Nz(tabRS!MNO, "") If foundMno <> "" Then .Edit !MNO = foundMno .Update End If Else ' more than one record found and that shouldn't happen ' Debug.Print "Found Times is : " & tabRS.RecordCount, rs!BookName, rs!B_Hno Do While Not tabRS.EOF sPos = 0 i = 0 startPos = 0 endPos = 0 exNum = "" stext = "" stext = tabRS!NASS sPos = InStr(1, stext, rs!B_Hno) i = sPos Do While i > 0 And IsNumeric(Mid(stext, i, 1)) i = i - 1 Loop startPos = i + 1 ' Move forward to find the end of the number i = sPos Do While i <= Len(stext) And IsNumeric(Mid(stext, i, 1)) i = i + 1 Loop endPos = i - 1 exNum = Mid(stext, startPos, endPos - startPos + 1) If rs!B_Hno = exNum Then .Edit !MNO = Nz(tabRS!MNO, "") .Update Exit Do End If tabRS.MoveNext Loop End If If Not tabRS Is Nothing Then tabRS.Close Set tabRS = Nothing End If Else ' BookName or B_Hno are Empty Debug.Print "BookName or B_Hno are Empty" End If .MoveNext If totalRec Mod 1000 = 0 Then DoEvents Loop End With If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing End Sub

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

لو ده شكلك وانت بتبص ع الاكواد دا كان شكلى وانا باكتبها وافكر فيها

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

زاكر

طيب لو فاكر يا دكتور انا قلت وبعد ذلك سوف اخبركم برأى فى الاخر وهذا هو رأى عمليا فى المرفق الاتى نموذج غير منضم وحقول غير منضمة ايون زيمبئولك كده فعلا نموذج غير منضم اصلا ومن خلاله نستعرض البيانات ونتحرك بين السجلات ونعدل البيانات ونحذف البيانات ونضيف سجل جديد مش انت عاوز تذاكر كلمة مرور التعديل : 123 كلمة مرور الحذف : 000 حفظ وتعديل (3).accdb

تفضل استاذ @2saad طلبك حسب مافهمت .ووافني بالرد . mas_s (KK1960).rar

أخي الكريم @nssj ، بداية دعني أوضح لك نقاط مهمة في الدوال التي تعمد على البحث داخل سجلات عن قيم غير ثابتو ولا تتبع اسلوب محدد في موضعها ، فإنه مع كثيرة السجلات والبيانات في الجداول مستقبلاً ستأخذ وقتاً أوطول كلما زادت كميوة الداتا في الجدول المستهدف للبحث فيه . وهذا أمر طبيعي ، وسأحاول جاهداً توظيف الكود ليكون سلساً وسهلاً في آلية عمله . ثانياً ، اعذرني لأني أحيانا لا أدقق في النتائج بشكل ممعن كصاحب الموضوع على العموم ، جرب هذا التعديل البسيط لجعل الكود بعتمد البحث عن الرقم بطريقتين:- الأولى حيث يتبع الرقم مباشرة اسم الكتاب، والثانية حيث يكون الرقم موجودًا داخل النص دون الالتزام بموضع محدد ، في الكود التالي ، وأخبرني بالنتيجة سريعاً الكود : Dim db As DAO.Database Dim rsBooks As DAO.Recordset Dim rsTab As DAO.Recordset Dim sql As String Dim bookNumber As String Dim found As Boolean Set db = CurrentDb() Set rsBooks = db.OpenRecordset("BOOKS") Do While Not rsBooks.EOF bookNumber = rsBooks!B_Hno found = False sql = "SELECT * FROM TAB WHERE NASS LIKE '" & rsBooks!bookName & " " & bookNumber & "%'" Set rsTab = db.OpenRecordset(sql) If Not rsTab.EOF Then rsTab.MoveFirst Do While Not rsTab.EOF If InStr(rsTab!NASS, bookNumber) = Len(rsTab!bookName) + 2 Then rsBooks.Edit rsBooks!MNO = rsTab!MNO rsBooks.Update found = True Exit Do End If rsTab.MoveNext Loop End If If Not found Then sql = "SELECT * FROM TAB WHERE InStr(NASS, '" & bookNumber & "') > 0" Set rsTab = db.OpenRecordset(sql) If Not rsTab.EOF Then rsTab.MoveFirst Do While Not rsTab.EOF If InStr(rsTab!NASS, bookNumber) > 0 Then rsBooks.Edit rsBooks!MNO = rsTab!MNO rsBooks.Update found = True Exit Do End If rsTab.MoveNext Loop End If End If rsTab.Close Set rsTab = Nothing rsBooks.MoveNext Loop rsBooks.Close Set rsBooks = Nothing Set db = Nothing المرفق بعد التعديل :- Smart_Search03.accdb

ماشاء الله استاذ خليفه زادك الله علما هو بالضبط كما اريد بوركت الجهود

إنت المفروض تفرح على الشغل العدل ذا .. إنت مزعل نفسك ليش ؟!! 😅😂 لا توجد مشكلة مع السلاسل الطويلة مادم النتيجة فتاكة 👍🏻😉 وأحلى حاجة في شغلك أنه لايوجد بروق ورعود فيها ( إهتزاز ) زي ما عودنا الأكسس .. والحركة سلسة فيها ما شاء الله ☺️ تم إضافة الصور المتحركة لعيونك ياحبيب الملايين 😎👌

جزيل الشكر للمبدع ابوالبراء ياسر خليل ولاستاذنا الاستاذ حسونة حسين

دا انا هادوس بالجامد

ولوو ،، دا يسعدني يا باشا بس ما تتكاش أوي يعني

تمام يا استاذ @Foksh تم الان اضافة المرفق النهائى الى رأس الموضوع

لا بجد والله انا بعتذر ، يبدو ان المشكلة في سيرفر الميديا فاير ، هرفع الملف تاني وارجو استبدال الرابط في المشاركة 😬

انت بتستعماني يا هرم لا وبتقول لى صديقى كمان النسخة الأخيرة Salawat 2024.accde والرابط ده بتاع الصوت يا عسل اسأل الله تعالى الرحمة والمغفرة لكم ولوالديكم ولأبى وأمى ولكل المسلمين طبعا انا بهزر معاك يا عسل بلاش شغل التلت ورقات وهات المرفق المفتوح بالتى هى احسن

شكرا جزيلا اخي العزيز

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

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

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

عاوز نسخة مفتوحة لحسن هأعيط واخلى الناس تتلم عليك

تم اضافة الاصدار الثانى فى الراس الموضوع ( المشاركة الاصلية) طبعا على طريقة المعقدين امثالى با استاذ @Moosak لانه لم نحصل حتى الان على الحلول البسيطة السهلة بتاعة الناس الرايقة التى لا تستخدم السلاسل الطويلة وياريت لو تتكرم يا استاذ @Moosak بعمل تصوير gif من واقع تجربة المرفق الثانى لكل من النموذجين وترفقهم برأس الموضوع لان جهازى يختضر

جرب هذه الفكرة معلمي الفاضل @ابوخليل :) Private Sub Combo4_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub

ما شاء الله ابداع