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

وضح أخي الفاضل بمثال مرفق .. هل تريد جمع نص مع رقم؟

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

إلى حين إرفاق ملف جرب المرفق التالي Find Duplicates In Different Sheets.rar

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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أقدم لكم اليوم كيفية فتح مستند نصي (مستند ورد) عن طريق فتح تطبيق الورد من داخل الإكسيل .. في الملف المرفق يوجد ملف إكسيل وملف ورد لعمل اختبار عليه .. قم بفك الضغط عن الملف المرفق على سطح المكتب مثلاً عند الضغط على زر الأمر في ورقة العمل ، سيقوم الكود بفتح صندوق حواري (مستعرض الملفات) لتقوم بتحديد مكان أو موقع المستند الذي تريد فتحه .. قم بالذهاب إلى مسار المستند وقم بتحديده ثم اضغط Open لفتح الملف .. إذا لم يتم اختيار ملف ستظهر رسالة تفيد بذلك .. يوجد أيضاً دالة معرفة داخل الموديول تقوم بفحص ما إذا كان الملف مفتوح أم لا ، فإذا كان الملف مفتوح مسبقاً يتم الخروج من الإجراء الفرعي .. إذا أردت التخلص من الدالة وتقليل حجم الكود قم بمسح الدالة Function (الجزء الثاني في الموديول) كما قم بمسح هذا السطر من الكود If IsFileOpen(Sheet1.Range("A1").Value) Then Exit Sub هذا السطر تمت إضافته لفحص الملف إذا ما كان مفتوح أم لا ..لأنه في حالة إذا كان الملف مفتوح مسبقاً وقمت بفتحه مرة أخرى ، سيتسبب ذلك في بطء عمل الكود ، وينتهي برسالة خطأ .. شكل الكود المسئول عن فتح المستند ببرنامج الورد Sub Browse() 'تعريف المتغيرات '---------------- 'تعريف المتغير الذي سيأخذ قيمة مستعرض الملفات Dim strFileToOpen 'تعريف المتغير الذي يشير إلى إنشاء كائن تطبيق الورد Dim objWord 'تعريف المتغير الذي يشير إلى المستند النصي Dim objDoc 'نافذة المستعرض '-------------- 'تعيين قيمة المتغير ليساوي قيمة نافذة مستعرض الملفات ، والذي يمثل مسار المستند الذي يتم اختياره strFileToOpen = Application.GetOpenFilename(Title:="Please Choose A File To Open", FileFilter:="Word Files *.doc* (*.doc*),") 'اختبار اختيار المستند '--------------------- 'إذا لم يتم اختيار مستند يتم إظهار رسالة تنبيه ثم الخروج من الإجراء الفرعي If strFileToOpen = False Then MsgBox "لم يتم اختيار ملف", vbExclamation, "تنبيه" Exit Sub 'إذا كان المستند مفتوح يتم الخروج من الإجراء الفرعي Else 'تساوي قيمة نافذة مستعرض الملفات [A1]الخلية 'يتم وضع مسار المستند بالكامل في الخلية Sheet1.Range("A1").Value = strFileToOpen 'إذا كان المستند مفتوح مسبقاً يتم الخروج من الإجراء الفرعي If IsFileOpen(Sheet1.Range("A1").Value) Then Exit Sub 'تعيين قيمة المتغير ليساوي تطبيق الورد Set objWord = CreateObject("Word.Application") 'تعيين قيمة المتغير ليساوي المستند الذي سيتم فتحه بتطبيق الورد Set objDoc = objWord.Documents.Open(strFileToOpen) 'إظهار تطبيق الورد objWord.Visible = True End If End Sub والدالة المسئولة عن عملية فحص الملف ما إذا كان مفتوح أم لا Function IsFileOpen(filename As String) '[False]أو إلى[True]هذه الدالة تقوم باختبار إذا ما كان الملف مفتوح مسبقاً وترجع القيمة إما إلى Dim filenum As Integer, errnum As Integer On Error Resume Next 'هذا السطر لتجنب رسائل الخطأ filenum = FreeFile() 'الحصول على رقم للملف 'محاولة فتح الملف ثم إغلاقه Open filename For Input Lock Read As #filenum Close filenum 'إغلاق الملف errnum = Err 'حفظ رقم الخطأ الذي يحدث On Error GoTo 0 'استعادة خاصية رسائل الخطأ 'فحص رقم الخطأ Select Case errnum 'في حالة عدم وجود خطأ ، إذاً الملف غير مفتوح Case 0 IsFileOpen = False 'الرقم 70 يعني أن الملف مفتوح وغير مصرح بالدخول عليه Case 70 IsFileOpen = True 'في حالة حدوث خطأ آخر Case Else Error errnum End Select End Function أترككم مع الملف .. ويوجد شرح لأسطر الكود دمتم في عز الله وطاعته Open Word Document.rar

أخي الحبيب الملف الذي قمت بتحميله والذي قدمه لك الأخ الحبيب محمد الريفي يعمل بشكل جيد وراجعت معادلاته وتعمل بشكل جيد ..حاولت أن أجد خطأ للأخ محمد الريفي (عشان أجهز الفلكة !) لكن للأسف المعادلات زي الفل .. المشكلة في توصيل الطلب .. إذا كان التقصير من أحد فهو منك (متزعلش مني) ... النموذج المرفق ليس فيه ما ذكرت في مشاركتك الأخيرة .. في العمود K والذي بعنوان "منظم الوثيقة" يحتوي على بيانات لوثيقة واحدة فقط وليس كما ذكرت 4 وثائق في الصف الواحد .. يرجى إرفاق ملف بالشكل الصحيح لقاعدة البيانات التي تعمل عليها حتى يتم العمل بشكل صحيح إن شاء الله

محدش رد عليا من المشرفين ... هو مفيش مشرفين ولا النهاردة الجمعه أجازة !!

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

أخي الحبيب أبو إيمان مشكلة الكهرباء في مصر أصبحت شيء عادي .. يعني لو الكهربا مقطعتش يبقا الواحد نفسيته مش مرتاحة .. يحس إن فيه حاجة غلط اتعودنا على كدا .. يعني لو طرحنا المشكلة في المنتديات الأجنبية على سبيل المثال ، أكيد هيكون الرد (معقولة الكهربا ممكن تقطع !) وممكن يعجزوا عن حل المشكلة لأنهم لم يواجهوها من قبل بصراحة فكرتك بسيطة ورائعة وحلت المشكلة بالتأكيد بارك الله فيك وجزاك الله خير الجزاء

مشكور على مرورك العطر يا مخ (طار) لكم يسعدني عودتك للمنتدى بعد طووووول غياب .. في انتظار إبداعاتك المفيدة والجديدة

أخي المشاكس .. هلا وضحت وجهة نظرك؟ أم أنك اكتفيت بردي في المشاركة رقم 2 ...

أخي الفاضل أهلا ومرحبا بك في المنتدى .. أولاً يفضل إرفاق ملف ، قم بضغط الملف ثم رفعه ، وإذا كان حجم الملف الأصلي كبير قم بتخفيفه ثم ضغطه ثم رفعه ثانيا الطلب غير واضح حيث أنك ذكرت حذف المكرر وفي آخر الكلام ذكرت أنك تريد إعطاءه لون فريد (والطلبين مختلفين : يا ده يا ده) ثالثا ما نوع البيانات في تلك الأعمدة ..هل هي بيانات نصية أم رقمية أم أم؟

يرجى تغيير عنوان الموضوع ليعبر عنه ..

وعليكم السلام وجزيت بمثله أخي الحبيب أبو نبأ .. نشكرك على الرد .. نريد أن يشمل الرد ما هو أفضل الحلول التي قدمت ..هل المعادلة أم الكود الأول أم الكود الثاني أم أنه كود آخروجدته في الموضوع المشار إليك فيه ، حيث أنك أخبرت أن عدد الصفوف تقريبا 250000 يعني ربع مليون .. فأنا متطلع لمعرفة أكفأ طريقة أدت نفعاً معك تقبل تحياتي

الأخ الفاضل عبد الرحمن الحمد لله أنك توصلت لحل المشكلة .. بدلا من مسح الموضوع أرفق الحل الذي توصلت إليه ، فلعله يفيد شخص ما فيما بعد (مش كدا ولا ايه) تقبل تحياتي

الأخ الفاضل إسلام سامي شوف عناوين الأعمدة A - B - C - D - E ، بص فوق العناوين مباشرة .. شايف الشريط الطويل اللي جنبه كلمة fx أيوا هو دا شريط المعادلات Formula Bar .. اعمل كليك على كلمة fx هيطلعلك نافذة في أولها قايمة منسدلة افتحها (متخافش مش هتطلع عفريت) ..هتلاقي في آخرها User-Defined .. في الجزء السفلي هتلاقي الدوال UDFs الموجودة في الملفين اللي إنت وضعتهم في المجلد XLSTART .. بس خلاص ..

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

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

الأخ الحبيب شوقي ربيع بارك الله فيك ومشكور على مرورك العطر .. الملف لديك افعل به ما بدا لك وطوره كفيما شئت ، وأكيد نحن أول المستفيدين .. تقبل تحياتي القلبية أخي وأستاذي الكبير شوقي

أخي الفاضل تفضل المرفق التالي فيه حلول بالمعادلات وبالأكواد .. إن شاء الله يؤدي الغرض Find Missing Numbers.rar

السلام عليكم ورحمة الله وبركاته إخواني الأحباب في المنتدى الأغر .. أقدم لكم كود في منتهى الروعة ، يقوم بعمل خريطة (ليست الخريطة التي في مخيلتكم .. أنا معلم لغة إنجليزية ولست معلم دراسات اجتماعية) الكود يعتمد على إنشاء ورقة عمل جديدة .. لبدء العمل فيها بناءً على ورقة العمل النشطة التي يتم تنفيذ الكود بها .. ورقة العمل الجديدة تحتوي على خلايا ملونة وداخلها رموز .. للتعرف على القيم الرقمية والنصوص والمعادلات الموجودة داخل ورقة العمل النشطة .. 'وتلوينها باللون الأصفر[N]يتم ترميز الخلايا التي تحتوي على قيم رقمية بالرمز ' وتلوينها باللون الأخضر[T]يتم ترميز الخلايا التي تحتوي على قيم نصية بالرمز 'وتلوينها باللون الأحمر[F]بالرمز[Formulas]يتم ترميز الخلايا التي تحتوي على معادلات ويوضع الكود داخل موديول بهذا الشكل Sub QuickMap() If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 'Create object variables for cell subsets إنشاء متغيرات للكائنات التي تمثل مجموعات الخلايا On Error Resume Next Set FormulaCells = Range("A1").SpecialCells _ (xlFormulas, xlNumbers + xlTextValues + xlLogical) Set TextCells = Range("A1").SpecialCells(xlConstants, xlTextValues) Set NumberCells = Range("A1").SpecialCells(xlConstants, xlNumbers) On Error GoTo 0 'Add a new sheet and format it إنشاء ورقة عمل جديدة وعمل تنسيق لها Sheets.Add With Cells .ColumnWidth = 2 .Font.Size = 8 .HorizontalAlignment = xlCenter End With Application.ScreenUpdating = False 'Do the formula cells التعامل مع الخلايا التي تحتوي على معادلات If Not IsEmpty(FormulaCells) Then For Each Area In FormulaCells.Areas With ActiveSheet.Range(Area.Address) .Value = "F" .Interior.ColorIndex = 3 End With Next Area End If 'Do the text cells التعامل مع الخلايا التي تحتوي على نصوص If Not IsEmpty(TextCells) Then For Each Area In TextCells.Areas With ActiveSheet.Range(Area.Address) .Value = "T" .Interior.ColorIndex = 4 End With Next Area End If 'Do the numeric cells التعامل مع الخلايا التي تحتوي على قيم رقمية If Not IsEmpty(NumberCells) Then For Each Area In NumberCells.Areas With ActiveSheet.Range(Area.Address) .Value = "N" .Interior.ColorIndex = 6 End With Next Area End If End Sub فائدة الكود تكمن في إمكانية التعرف على الأخطاء التي يمكن أن تتواجد في ورقة العمل .. . لنفترض أن لديك عمود به معادلات ، وعن طريق الخطأ تم إدخال قيم ثابتة في هذا العمود .. باستخدامك لهذا الكود سيكون بإمكانك وضع يدك على الخلايا التي بها قيم ثابتة في العمود الذي يحتوي على معادلات .. أتمنى أن ينال الملف المرفق رضاكم ، وأن تستفيدوا منه إن شاء الله عزوجل تقبلوا تحياتي القلبية ، ودمتم على طاعة الله Quick Map VBA.rar

المشاركة رقم 12 مشاركة مكررة .. تقبل تحياتي

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

السلام عليكم ورحمة الله وبركاته إخواني الكرام ..أحبابي في الله أقدم لكم اليوم كودين ، تعتمد الفكرة فيهما على تجميع القيم التي يتم إدخالها ، مع كل إدخال جديد في المرفق ستجد ملفين .. الملف الأول باسم Single Cell Accumulator أي التجميع للقيم في خلية واحدة فقط ويظهر الناتج في نفس الخلية .. قم بإدخال أي قيمة في الخلية A1 وليكن 5 ثم سهم لأسفل واكتب القيمة 4 ستجد أن ناتج الخلية أصبح 9 ، اكتب 3 ثم سهم لأسفل ستجد الناتج أصبح 12 وهكذا .. أعتقد أن فكرة الكود قد وصلتكم الآن .. لإعادة ضبط عملية التجميع قم بمسح محتويات الخلية A1 أو وضع نص بها .. الكود في الملف الأول بهذا الشكل (في حدث ورقة العمل) Private Sub Worksheet_Change(ByVal Target As Excel.Range) Static dAccumulator As Double With Target If .Address(False, False) = "A1" Then If Not IsEmpty(.Value) And IsNumeric(.Value) Then dAccumulator = dAccumulator + .Value Else dAccumulator = 0 End If Application.EnableEvents = False .Value = dAccumulator .Select Application.EnableEvents = True End If End With End Sub الملف الثاني باسم Two Cell Accumulator وفي هذا الملف تتم عملية الإدخال في الخلية A1 بينما تظهر النتائج في الخلية B1 ، ففي كل إدخال رقمي يتم تجميع القيمة إلى القيمة الموجودة في الخلية A1 ، وهنا إذا تم مسح محتويات الخلية A1 أو كتابة نص بها ، فإن الناتج في الخلية B1 يظل كما هو ، ولإعادة ضبط عملية التجميع من جديد قم بمسح محتويات الخلية B1 والكود في الملف الثاني يظهر بهذا الشكل (في حدث ورقة العمل) Private Sub Worksheet_Change(ByVal Target As Excel.Range) With Target If .Address(False, False) = "A1" Then If IsNumeric(.Value) Then Application.EnableEvents = False Range("B1").Value = Range("B1").Value + .Value Application.EnableEvents = True .Select End If End If End With End Sub أرجو من الله أن يجعل أعمالنا صالحة ، ولوجهه خالصة .. دمتم في رعاية الله حمل الملف من هنا

أخي الحبيب عمار أنا لم ولن أتضايق من أخي المسلم أبداً ما حييت ..هكذا علمني رسولي (أذلة على المؤمنين أعزة على الكافرين) اللهم اجمع المسلمين على كلمة الحق .. وانصرنا على القوم الظالمين