أ / محمد صالح

يمكنك إضافة شكل شفاف بدون إطار وعند تحديده تكتب في شريط المعادلة =J5 ليعرض النص المختار من القائمة ويمكن تحريك هذا الشكل إذا تغير حجم الصورة بالتوفيق

ما دامت ورقة العمل محمية فلا يمكن دمج الخلايا إلا باستعمال كود VBA وأن يبدأ الكود بسطر لفك الحماية ثم أي كود تريده كدمج نطاق معين أو دمج الخلايا المحددة ثم آخر سطر لإعادة حماية الشيت مرة أخرى ActiveSheet.Unprotect "password" Range("C3:E3").Merge 'Selection.Merge ActiveSheet.Protect "password" وأنصح ألا يحتاج المستخدم لدمج خلايا جديدة بعد حماية ورقة العمل فالأولى دمج الخلايا قبل الحماية بالتوفيق

خطوة جميلة بالتوفيق

ما شاء الله إبداع وفقك الله أخي الفاضل ابو أحمد

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

تفضل جرب هذا التعديل جعل اسم مربع النص 11 وليس 12 وعمل بعض التعديلات في نوع المتغيرات التي تساعد في عملية البحث بالتوفيق متابعة8.xlsm

يبدو أن حضرتك لم تقرأ الرد السابق للأستاذ محمد حسن وخصوصا آخر حل وهو تعديل كود التفقيط ليناسب الأعداد الترتيبية جميعها وبالنسبة لعدم ظهور الرقم يمكن أن تمرر للدالة رقم الصف row() أو تنقص منه أي عدد من الصفوف ليبدأ من 1 بالتوفيق

أخي الكريم مطلوبك سهل بإذن الله لكن يوجد بعض الخطوات قبل تنفيذه وهي: إعادة حفظ الملفات باسم (ولو بنفس الاسم) حيث أنها تظهر خطأ عند فتحها ضبط مكان الارقام في العمود K حيث أنها في معظم الملفات في العمود K بعدها اصنع ملفا وضع به هذا الكود Sub GetDataFromFiles() Dim oFSO As Object, oFolder As Object, oFile As Object Dim lr As Long, iCnt As Long, iTotalRows As Long Dim src As Workbook, dst As Workbook Set dst = ActiveWorkbook Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder(ActiveWorkbook.Path) Application.ScreenUpdating = False For Each oFile In oFolder.Files If oFile.Name <> ActiveWorkbook.Name And Left(oFile.Name, 1) <> "~" Then Set src = Workbooks.Open(oFile.Path, True, True) iTotalRows = src.Worksheets(1).Cells(Rows.Count, "K").End(xlUp).Row For iCnt = 1 To iTotalRows lr = dst.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row dst.Sheets(1).Range("A" & lr + 1).Value = src.Sheets(1).Range("K" & iCnt).Value Next iCnt src.Close False End If Next oFile Set oFSO = Nothing: Set oFolder = Nothing: Set oFile = Nothing Application.ScreenUpdating = True MsgBox "Done by mr-mas.com" End Sub ثم قم بتنفيذ هذا الإجراء سيتم جلب بيانات العمود K من الملفات في العمود A في الملف الجديد الذي به الكود بالتوفيق

بارك الله لك أخي @أبومروان ويمكن اختصار هذه المعادلة إلى هذه =CHOOSE(B1,"الأول","الثاني","الثالث","الرابع","الخامس","السادس","السابع","الثامن","التاسع","العاشر","الحادي عشر","الثاني عشر","الثالث عشر","الرابع عشر","الخامس عشر","السادس عشر","السابع عشر","الثامن عشر","التاسع عشر","العشرون") بالتوفيق

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

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

الدالة تنفع في هذا الغرض أخي الكريم ربما التنفيذ خطأ هذا بخصوص الملف المرفق من الأخ أبو أحمد لأنه بعد وضع المعادلة يتم التصفية على رقم 1 ويعني هذا أن هذا الرقم موجود في القائمة الصغرى (الموجودة في العمود A ) بعد عمل فلتر على الخلايا التي بجانبها رقم واحد تحديد هذه الصفوف ثم كلك يمين على رأس الصف ثم حذف ليتم حذف هذه الصفوف التي كانت موجودة في القائمة الصغرى بعد الحذف تلغي القلتر بس خلاص

لا أدري ما معنى كلمة (نفس المشكلة) ؟؟؟؟ الصورة المرفقة تدل على أن الاكسل قام بحذف 477 من المكررات وتبقى 1424 بعد أن كان يظهر رسالة لا يوجد مكررات وهذه صورة نتيجة تحويل الخلايا لأرقام عن طريق زر الخطأ وليس عن طريق تنسيق الخلايا ثم حذف المكررات

بالنسبة لمن يستخدم نسخ قديمة فيه موضوع قديم اسمه بدائل textjoin فيه دالة معرفة vba يممكن استعمالها بنفس الطريقة

لا مشكلة اذا استخدمت معادلة العد بشرط =IF(AND(COUNTIF($A$2:$A$20, A2)>1, COUNTIF($A$2:A2, A2)=1), TEXTJOIN(",", 1,IF($A$2:$A$20=A2,$B$2:$B$20, "")),"") موفق ان شاء الله

يمكنك استخدام هذه المعادلة في أوفيس 2019 في الخلية C2 =TEXTJOIN(",", 1,IF($A$2:$A$20=A2,$B$2:$B$20, "")) بالتوفيق

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

أخي الكريم استعمال معادلات الصفيف في نطاق واسع يبطئ الملف جدا وأحد الحلول لعمل تصفية بالمعادلات هي وجود عمود مسلسل مساعد في شيت البيانات الكبير وتغيير معادلة المسلسل في شيت التقرير ومعادلة البحث في شيت التقرير هذا ملفك بعد التعديل لإيصال الفكرة (يمكنك استكمال معادلة البحث في باقي الأعمدة) بالتوفيق Retails Sales Report.xlsx

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

يمكنك وضع هذه المعادلة في الخلية B4 =DATE(MID(LEFT(RIGHT(I4,12),8),1,4),MID(LEFT(RIGHT(I4,12),8),5,2),MID(LEFT(RIGHT(I4,12),8),7,2)) والاستغناء عن الأعمدة المساعدة بالتوفيق

حسب فهمي للمطلوب يلزمك تغيير المعادلة في الخلية E2 إلى =SUMIFS(الصرف!$C$2:$C$8,الصرف!$B$2:$B$8,$A$1,الصرف!$A$2:$A$8,">="&D2,الصرف!$A$2:$A$8,"<="&EOMONTH(D2,0),الصرف!$C$2:$C$8,">="&0)*$L$1+SUMIFS(الصرف!$C$2:$C$8,الصرف!$B$2:$B$8,$A$1,الصرف!$A$2:$A$8,">="&D2,الصرف!$A$2:$A$8,"<="&EOMONTH(D2,0),الصرف!$C$2:$C$8,"<"&0) رغم اعتراضي على اختلاف طريقة تسجيل البيانات فإذا كان العدد 3 يتم ضربه في 1000 لذلك يجب كتابة ال 500 على صورة 0.5 فهذا سيقلل المعادلة ويضبط المخرجات بالتوفيق

بارك الله فيك أخي الكريم وفقكم الله

يمكنك فعلها من خلال أزرار التبويبات data --- sort أو تسجيل ماكرو بهذا لتحصل على الكود بالتوفيق

لا يمكن ضم المواضيع في البحث ولكن يمكن دمجها في المنتدى اولا من خلال المشرفين وفقنا الله جميعا لكل ما يحبه ويرضاه

بارك الله فيكم جميعا جميل جدا هذا العمل إبداع وهذه مساهمتي للبحث في موضوعات منتدى الاكسس ولكن في مجال الويب حتى يمكن البحث بسرعة بمجرد الكتابة ولو في الموبايل بدون الحاجة إلى برنامج الأوفيس https://officena.net/team/mas/access.html بالتوفيق للجميع دعواتكم