كل الانشطه

المثال: hashtags_01.accdb

استخدم دالة IsNumeric إذا كانت النتيجة 0 أو false فهي القيمة المطلوبة

قمت بتجربة كلى المعياريين التاليين ولكن لم يجدي نفعا Like "*#*" Not Like "*#*"

السلام عليكم ورحم الله لدي حقل داخل جدول اكسيس به بيانات على سبيل المثال "5365#" اريد معيار لاستعلام اكسيس يقوم باستخراج الحقول التى بها رمز # مرفق نموذج باسم hashtags للتجربة hashtags.accdb

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

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

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

وهذا حل ثالث اقصر Function JosephusOneLine(n As Integer) As Integer JosephusOneLine = 2 * (n - 2 ^ Int(Log(n) / Log(2))) + 1 End Function

حلول ذكية منقولة الحل الأول: Function Survivor(pCount As Integer) As Variant Dim Res As String Survivor = "#NUM!" If pCount < 1 Or pCount > 511 Then Exit Function Res = WorksheetFunction.Dec2Bin(pCount) Res = Mid(Res, 2) & Left(Res, 1) Survivor = WorksheetFunction.Bin2Dec(Res) End Function الحل الثاني: Function Survivor(pCount As Integer) As Integer Dim Prisoners As String Dim k As Integer, v As Integer Prisoners = String(pCount, "1") Do While Replace(Prisoners, "0", "") <> "1" k = InStr(v + 1, Prisoners, "1"): If k = 0 Then k = InStr(1, Prisoners, "1") v = InStr(k + 1, Prisoners, "1"): If v = 0 Then v = InStr(1, Prisoners, "1") Prisoners = Left(Prisoners, v - 1) & "0" & Mid(Prisoners, v + 1) Loop Survivor = InStr(1, Prisoners, "1") End Function آمل من المشرفين الكرام إقفال هذا الموضوع فقد وئد في يومه الأول. شكرا للجميع.

😇 تحديث 1- تصحيح التوقيت التنفيذ للاحتساب عن طريق دالة بسيطة 2- اضافة تاب سفلي كتغير واضافة الى النافذة بطريقة سهلة ---------------------------------------------- =========================() تحميل المرفق https://www.mediafire.com/file/g4uyr43fywxh1jy/Update_Silent-Print-with_Out_PDF.rar/file

مرفق شيت به 1000 اختصار لبرنامج الاكسيل لتسهيل العمل منظم حسب الاصدارات للاستاذ/ محمود سيد جزاه الله خيرا 1000 اختصار للاكسيل محمود سيد.xlsx

الله يعطيك العافيه شكرا لك اخي🌹

من داخل الدالة المرفقة ، تستطيع حتى جعله = زحلون مريخي الزحلون المريخي عملة مريخية هههههههههه ( امازحك 😅 )

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

وعليكم السلام ورحمة الله وبركاته .. نعم أخي تستطيع ذلك ، في المرفق التالي فكرة مشتقة من أحد المشاريع القديمة ، وتقوم بنفس الطلب الذي تريده . فقط املأ الارقام وانقر زر ارسال واتس اب تم حذف بعض الوظائف الخاصة بالمشروع الأصلي .. WhatsApp Sender WF.accdb

ولمن يتسائل عن عدد الدورات Public Function LastSurvivor(Optional ByVal lngN As Long = 10, Optional ByVal lngK As Long = 2) As Long Dim colPeople As Collection Dim lngIndex As Long Dim i As Long Dim killer As Long Dim totalCycles As Long Dim currentPosition As Long Dim stepKilled() As Long Set colPeople = New Collection For i = 1 To lngN colPeople.Add i Next i ReDim stepKilled(1 To lngN) lngIndex = 1 currentPosition = 1 totalCycles = 0 Do While colPeople.count > 1 lngIndex = ((lngIndex + lngK - 2) Mod colPeople.count) + 1 If lngIndex = 1 Then killer = colPeople(colPeople.count) Else killer = colPeople(lngIndex - 1) End If If currentPosition > lngIndex Then totalCycles = totalCycles + 1 End If currentPosition = lngIndex stepKilled(colPeople(lngIndex)) = totalCycles + 1 Debug.Print "السجين " & killer & " قتل السجين " & colPeople(lngIndex) & " (الدورة " & stepKilled(colPeople(lngIndex)) & ")" colPeople.Remove lngIndex If lngIndex > colPeople.count Then lngIndex = 1 Loop LastSurvivor = colPeople(1) Debug.Print "============" Debug.Print "الناجي الأخير هو السجين " & colPeople(1) Debug.Print "إجمالي عدد الدورات: " & totalCycles + 1 End Function اعتذر يبدو اننى لم احسن الفهم وتسرعت فى مسألة الشروط التى لم انتبه لها وبالنسبة لاجابة السؤال الاخير: اول مره اكتب هذه الوظيفة اساسا ولكن الموضوع يعتمد على الرياضيات البحته فى المقام الاول بدون فهم المنطق الرياضى لن تستطيع كتابة الكود ومن أجل ذلك ايضا تعمدت وضع المصدر

كان يجب عليك الإلتزام بالسؤال والشروط، هو سؤال وليس تنظيرا لنظرية ما. لم تجب على الجزء الآخر من السؤال، هل كتب الدالة بعد قراءتك للسؤال أم كتبتها سابقا؟.

- بحثك عن الحل عن طريق الإنترنت. لم ابحث عن شئ أعرف القصة التاريخية فاللغز معروف باسم "مشكلة يوسف" نسبة إلى المؤرخ اليهودي يوسيفوس فلافيوس (Josephus Flavius) فقط وضعت المصدر اثراء للموضوع وزيادة فى المعرفة - إضافة خيارات غير مطلوبة في السؤال بسبب اعتمادك على مصدر خارجي وبسببه طال الكود. لا توجد اضافات ولذلك تم التعامل معها كمعاملات اختيارية بقيم افتراضية بناء على طرحك الغير كامل اساسا لاصل اللغز بناء على المنطق الرياضى البحت لتكتمل الفائدة لمن يريد الزيادة والاستفادة وكان ايضا ذلك هو السبب الثانى لوضع المصدر ولذلك لا توجد اى مخالفات ولا اطالة بدون داع فى الكود ونعم انا من كتبت الكود واشكرك على اطرائك

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

أستاذ يمكن الوصول للحل بدون معرفة عدد الدورات.

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

وظيفة واحدة تكفي لاجراء المطلوب Public Function SplitText(inputString As String, Optional extractNumbers As Boolean = False) As String Dim i As Integer Dim r As Integer Dim lets As String Dim result() As String Dim index As Integer Dim output As String r = Len(inputString) ReDim result(1 To r) index = 0 For i = 1 To r lets = Mid(inputString, i, 1) If extractNumbers Then If IsNumeric(lets) Then index = index + 1 result(index) = lets End If Else If Not IsNumeric(lets) Then index = index + 1 result(index) = lets End If End If Next i output = "" For i = 1 To index output = output & result(i) Next i SplitText = output End Function لاستخراج النص: SplitText([txtString]) لاستخراج الارقام : SplitText([txtString],True)

الكود Public Function LastSurvivor(Optional ByVal lngN As Long = 10, Optional ByVal lngK As Long = 2) As Long Dim colPeople As Collection Dim lngIndex As Long Dim i As Long Dim killer As Long Dim totalCycles As Long Dim currentPosition As Long Set colPeople = New Collection For i = 1 To lngN colPeople.Add i Next i ReDim stepKilled(1 To lngN) lngIndex = 1 currentPosition = 1 totalCycles = 0 Do While colPeople.count > 1 lngIndex = ((lngIndex + lngK - 2) Mod colPeople.count) + 1 If lngIndex = 1 Then killer = colPeople(colPeople.count) Else killer = colPeople(lngIndex - 1) End If If currentPosition > lngIndex Then totalCycles = totalCycles + 1 End If currentPosition = lngIndex colPeople.Remove lngIndex If lngIndex > colPeople.count Then lngIndex = 1 Loop LastSurvivor = colPeople(1) End Function الكود يعتمد على المصدر https://en.wikipedia.org/wiki/Josephus_problem

بالنسبة للعدد 7000 النتيجة = 5809 بالنسبة للعدد 500 النتيجة = 489 بالنسبة للعدد 10 النتيجة = 5

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