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

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

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

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

السلام عليكم ورحمة الله وبركاته كود البحث المتقدم باستخدام المصفوفات VBA Arrays قدم لنا الأخ الغالي ياسر العربي صاحب الجولات والصولات كود رائع ، ويستخدم الكود في البحث المتقدم ، وقد استخدم المصفوفات والتي هي عشقي في التعامل مع الأكواد ، حيث يتم تنفيذ جميع أسطر الكود بالذاكرة بعيداً عن التعامل بشكل مباشر مع ورقة العمل ، مما يجعل الكود أسرع مئات المرات من استخدام الحلقات التكرارية العادية. وقد ارتأيت أن أقوم بشرح لأسطر الكود ليكون مرجع لكل طالب علم ولكل باحث في هذا الخصوص ، ولنبدأ مرحلة جديدة من عالم الأكواد باستخدام المصفوفات VBA Arrays ، لما لها من مرونة عالية وسرعة فائقة في تنفيذ الأكواد. يوجد بالمرفق ورقتي عمل أحدهما باسم Data وفيها البيانات الخام من 14 عمود ، والورقة الأخرى باسم Result للنتائج وبها الخلية G2 والتي توضع بها نص الكلمة المراد البحث عنها. وإليكم الكود مع الشرح بالتفصيل (وضعت مثال بسيط ليستطيع المتتبع للشرح فهم الكود بسهولة) Sub Araby_Search() 'تعريف المتغير لورقة العمل التي تحتوي على البيانات الخام Dim wsData As Worksheet 'تعريف المتغير لورقة العمـل المطلـوب إظهـار النتائـج بها Dim wsResult As Worksheet 'تعريف المتغير ليحمل قيم المصفـوفة للبيانات الخـام Dim Arr As Variant 'تعريف المتغير ليحمل قيم المصفوفة للنتائج المطلوبة Dim Temp As Variant 'تعريـف المتغير من النـوع النصي ليحمـل قيمة أو نص البحث 'أي الكلمة المطلوب البحث عنها يتم تخزينها في هذا المتغير Dim strSearch As String 'تعريف المتغير وسيستخدم في الحلقة التكرارية لصفوف المصفوفة Dim I As Long 'تعريف المتغير وسيستخدم في الحلقة التكرارية لأعمدة المصفوفة Dim J As Long 'تعريف المتغير وسيستخدم في مصفوفة النتائج لزيادة مقدار الصفوف بمقدار واحد Dim P As Long 'تعيين قيمة للمتغير ليساوي ورقة العمل التي تحتوي '[Data] على البيانات الخام المطلوب معالجتها والمسماة Set wsData = Worksheets("Data") 'تعيين قيمة للمتغير ليساوي ورقة العمل التي تريد إظهار '[G2] النتائج بها بمجرد إدخال قيمة أو نص محدد في الخلية Set wsResult = Worksheets("Result") 'مسح النطاق الذي توضع فيه النتائج استعداداً لوضع النتائج الجديدة wsResult.Range("A8:N10000").ClearContents '[G2] تعيين قيمة للمتغير ليساوي قيمة الخلية 'وهي الخلية التي ستوضع فيها نص الكلمة المطلوب البحث عنها strSearch = wsResult.Range("G2").Value 'تعيين قيمـة للمتغير ليحمل قيم النطاق بالكامل للبيانات الخام ' وذلك [Data] حيث أن مصـدر البيانات الخام ورقة العمل المسماة 'عند [N] وينتهي في العمود [A5] في النطاق الذي يبدأ من الخلية '[&] آخـر صف به بيانات ، ويتم تحديده عن طريـق الجزء بعد علامـة Arr = wsData.Range("A5:N" & wsData.Cells(Rows.Count, 1).End(xlUp).Row).Value 'والتي ستحمل قيم النتائج [Temp] إعادة تعيين أبعاد المصفوفة المسماة '[Arr] وتكون بنفس أبعاد المصفوفة التي تحمل البيانات الخام والمسماة 'سنعتبر المصفوفة أشبـه بالصفـوف والأعمدة حيث الرقـم 1 يمثـل الصفـوف 'بإرجاع أكبر قيمة [UBound]بينما الرقم 2 يمثل الأعمدة ، وتقوم الكلمة 'أبعاد المصفوفة في هذه الحالة >> '------------------------------- 'البعد الأول سيكون من 1 إلى أكبر قيمة للصفوف 'البعد الثاني سيكون من 1 إلى أكبر قيمة للأعمدة ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) 'حلقة تكرارية من الصف الأول للمصفوفة إلى آخر صف بها For I = 1 To UBound(Arr, 1) 'إذا كان النص المطلوب البحث عنه فارغ يتم الخروج من تنفيذ الكود If strSearch = "" Then Exit Sub 'هذا السطر هو أهم سطر بالكود حيث هو الشرط الذي من خلاله 'والشرط [Temp] ستوضع النتائج في مصفوفة النتائج المسماة 'هـو تطابق قيمة المصفوفة في صف الحلقة في العمود رقم 14 'حيث يمثـل الرقم 14 العمود داخـل مصفوفة البيانات الخام '[strSearch] يتـم اختبـار التطابـق مع نـص البحث المسمى If Arr(I, 14) Like "*" & strSearch & "*" Then 'زيادة مقدار المتغير بمقدار 1 'فائدة المتغير هنا هو أنه مع كل حلقة تكرارية 'إذا تحقق الشرط فقط يزيد المتغير بمقدار واحد 'ليمثل هذا المتغير صفوف مصفوفة النتائج الجديدة P = P + 1 'حلقة تكرارية داخلية من العمود الأول للمصفوفة إلى آخر عمود بها For J = 1 To UBound(Arr, 2) 'تعبئـة مصفـوفة النتائـج بالبيانات مـن مصفوفة البيانات الخام '[Temp]مثـال لتتضح صورة كيفية تعبئة المصفوفة الجديدة المسماة 'في أول حلقـة سيكون مقداره 1 ويمثل أول صف [P] المتغيـر المسمى 'أول صف هنا لمصفوفة النتائج 'في أول حلقة سيكون مقداره 1 ويمثل أول عمود [J] المتغير المسمى 'في أول حلقة سيكون مقداره 1 ويمثل أول صف [I] المتغير المسمى 'أول صف هنا لمصفوفة البيانات الخام Temp(P, J) = Arr(I, J) 'الانتقال للحلقة التالية للأعمدة Next J 'نهاية جملة الشرط وهو تطابق نص البحث مع العمود رقم 14 في المصفوفة End If 'الانتقال للحلقة التالية في صفوف مصفوفة البيانات الخام Next I 'إذا كانت قيمة المتغير أكبر من صفر فهذا يعني أنه تم إيجاد نتائج للبحث 'حيث أن زيادة المتغير كما أوضحنا مقرونة بتحقق الشرط وطالما تحقق الشرط 'فهذا يعني أن مصفوفة النتائج سيكون بها بيانات ومن ثم يتحقق الجزء الثاني '[A8] وضع نتائج مصفوفة النتائج في أول خلية في ورقة النتائج في الخلية '[P] ويتم تمديد النطاق بمقدار عدد الصفوف طبقاً لقيمة المتغير المسمى '[Temp] وبمقدار عدد الأعمدة طبقاً لأكبر عدد لأعمدة المصفوفة المسماة If P > 0 Then wsResult.Range("A8").Resize(P, UBound(Temp, 2)).Value = Temp End Sub لتحميل الملف المرفق وللإطلاع على الموضوع الأصلي قم بزيارة الرابط التالي رابط الموضوع من هنا

السلام عليكم ورحمة الله وبركاته هل لديك بيانات حساسة ومهمة في ورقة العمل تريد ألا يطلع عليها أحد؟ طرق الحماية للإكسيل كما يعرف الجميع ضعيفة ، لذا فإن تشفير البيانات هو الحل الأمثل للوصول إلى حماية أفضل للبيانات. إخواني الكرام أقدم لكم طريقة لتشفير البيانات في ملفك ، وبنفس الكود ستتمكن من فك تشفير البيانات. خطوات العمل : >> قم بالدخول لمحرر الأكواد عن طريق Alt + F11 ، ثم من قائمة Insert أدرج موديول جديد Module ، وأخيراً الصق الكود التالي داخل الموديول. >> قم برسم زر أمر على ورقة العمل ، ثم كليك يمين على الزر واختر الأمر Assign Macro ثم اختر الإجراء الفرعي المسمى Encrypt_Decrypt Sub Encrypt_Decrypt() Dim xRg As Range Dim xPsd As String Dim xTxt As String Dim xEnc As Boolean Dim xRet As Variant Dim xCell As Range On Error Resume Next xTxt = ActiveWindow.RangeSelection.Address Set xRg = Application.InputBox("Select A Range:", "Select Range To Encrypt / Decrypt", xTxt, , , , , 8) Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange) If xRg Is Nothing Then Exit Sub xPsd = InputBox("Enter Password:", "Pass Entry") If xPsd = "" Then MsgBox "Password Cannot Be Empty", , "Kutools For Excel" Exit Sub End If xRet = Application.InputBox("Type 1 To Encrypt Cell(s)" & vbNewLine & vbNewLine & "Type 2 To Decrypt Cell(s)", "Encrypt = 1 / Decrypt = 2", , , , , , 1) If TypeName(xRet) = "Boolean" Then Exit Sub If xRet > 0 Then xEnc = (xRet Mod 2 = 1) For Each xCell In xRg If xCell.Value <> "" Then xCell.Value = Encryption(xPsd, xCell.Value, xEnc) End If Next xCell End If End Sub Private Function StrToPsd(ByVal Txt As String) As Long Dim xVal As Long Dim xCh As Long Dim xSft1 As Long Dim xSft2 As Long Dim I As Integer Dim xLen As Integer xLen = Len(Txt) For I = 1 To xLen xCh = Asc(Mid$(Txt, I, 1)) xVal = xVal Xor (xCh * 2 ^ xSft1) xVal = xVal Xor (xCh * 2 ^ xSft2) xSft1 = (xSft1 + 7) Mod 19 xSft2 = (xSft2 + 13) Mod 23 Next I StrToPsd = xVal End Function Private Function Encryption(ByVal Psd As String, ByVal InTxt As String, Optional ByVal Enc As Boolean = True) As String Dim xOffset As Long Dim xLen As Integer Dim I As Integer Dim xCh As Integer Dim xOutTxt As String xOffset = StrToPsd(Psd) Rnd -1 Randomize xOffset xLen = Len(InTxt) For I = 1 To xLen xCh = Asc(Mid$(InTxt, I, 1)) If xCh >= 32 And xCh <= 126 Then xCh = xCh - 32 xOffset = Int((96) * Rnd) If Enc Then xCh = ((xCh + xOffset) Mod 95) Else xCh = ((xCh - xOffset) Mod 95) If xCh < 0 Then xCh = xCh + 95 End If xCh = xCh + 32 xOutTxt = xOutTxt & Chr$(xCh) End If Next I Encryption = xOutTxt End Function شرح كيفية استخدام الكود : لتشفير البيانات : حدد النطاق أو الخلايا المراد تشفير البيانات بها ، انقر على زر الأمر ليظهر لك صندوق إدخال يمكنك من خلاله تحديد النطاق ، وبما أنك قمت بتحديد النطاق في البداية فلن يكون لديك سوى أن تنقر OK ، لتنتقل إلى صندوق إدخال آخر بعنوان Pass Entry ومن خلاله تدخل كلمة السر للتشفير ، وليكن 111 ، ثم انقر OK الآن سيظهر آخر صندوق إدخال وهو لإدخال الرقم 1 (للتشفير) ، أو الرقم 2 (لفك التشفير) بما أننا نريد التشفير سنقوم بكتابة الرقم 1 ثم ننقر OK ، ولاحظ البيانات في النطاق (لقد تم الأمر بحمد الله) لفك التشفير : ستقوم بتكرار نفس الخطوات بالضبط وتدخل نفس كلمة السر ، وفي آخر صندوق إدخال ستقوم بإدخال الرقم 2 لفك التشفير وأخيراً إليكم صورة توضيحية لكيفية التعامل مع الكود لتحميل الملف المرفق قم بزيارة الرابط للموضوع رابط الموضوع من هنا

الشرح المستفيض لكود البحث المتقدم باستخدام المصفوفات للأستاذ الكبير ياسر العربي Search Using Arrays http://adf.ly/1efc1m

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

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

مشكور أخي الكريم أبو يوسف النجار على مرورك العطر وردك الطيب

بارك الله فيك أخي الغالي بن علية ..حل رائع وممتاز كنت قد توصلت لمعادلة لاستخراج رقم الأسبوع ولم أكمل .. وقد تفضلت بإضافة حل رائع وممتاز وأعتقد حسب ما فهمت أنه يؤدي الغرض تقبل وافر تقديري واحترامي

اعتبر دا طلب مني .. اثراءً للموضوع أخي الغالي مختار

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

أخي الكريم أبو حنين .. المطلوب يحتاج لمزيد من المعطيات وأمصلة أكصر لتتضح الصورة جسب ما فهمت أنه سنقوم بفحص التاريخ في الخلية A1 فإذا كان في الأسبوع الأول أو الثالث فإنه يقوم بوضع القيمة A في الخلية D1 وإذا كان التاريخ يقع في الأسبوع الثاني أو الرابع يضع القيمة B ... هل ما فهمته صحيح؟ ... ويبقى السؤال : ما هو أول يوم معتمد كأول يوم في الأسبوع (السبت الأحد الإثنين .....) مثلاً شهر أكتوبر 2016 : أول يوم هو 1 / 10 / 2016 موافق ليوم السبت ..ماذا ستكون النتيجة في هذه الحالة لو كان يوم السبت يوم أجازة؟ هل ستوضع القيمة A في الخلية D1 .؟؟

لا يحدث ذلك معي ..مع كل مرة في تنفيذ الكود يتم إنشاء ورقة عمل جديدة ويوضع فيها الكود .. وكل مرة يقوم بذلك ..

بارك الله فيك وجزاك الله خيراً أخي العزيز طلعت محمد مشكور على مرورك العطر بالموضوع

بارك الله فيك أخي وحبيبي في الله أبو يوسف عوداً حميداً .. والله لقد اشتقنا لك ولرؤية ردودك المحفزة للعمل قدماً أخي الكريم نايف الكود بعد التنفيذ ينشيء ورقة عمل جديدة ثم يضع فيها الجزء الذي أشرت إليه .. ما المشكلة التي تواجهها بالتحديد حيث أنني لم أفهم مشكلتك الأخيرة؟

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

الحمد لله أن توصلت للحل

السلام عليكم أخي محمد هل تقصد حذف الملف (مصنف الإكسيل الذي يحوي الكود) أم ملف آخر يتم حذفه إذا تم اختراق حماية الملف؟

وجزيت خيراً أخي الغالي أحمد بمثل ما دعوت لي موضوع قديم وكنت قد نسيته .. تقبل وافر تقديري واحترامي

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

حاول ضبط إعدادات الإكسيل لديك راجع الموضوع التالي (طبق كما في الصور واحفظ الملف وأغلقه وأعد فتحه وجرب الكود مرة أخرى) من هنا أو احتمال آخر أن تكون المكتبة لديك إصدار آخر فقم بإزالة علامة الصح من هذا الإصدار وعلم علامة صح على الإصدار الموجود لديك ركز على تطبيق الإعدادات في الصورة التالية : ---------------------------------------------------

وعليكم السلام أخي الكريم حسين راجع التوجيهات في الموضوعات المثبتة في صدر المنتدى .. التوجيه الثالث عشر

أخي الكريم نايف يبدو أن الخطأ لم يحدث معك في الملف المرفق حيث أن الملف المرفق يعمل بشكل جيد .. لذا كان يجب عليك التوضيح أنك حاولت استخدام الكود في ملف آخر (فكلانا على خطأ) أعتذر عن الخطأ مني حيث أنني نسيت أن أخبرك بتفعيل المكتبة التالية

أخي الغالي الزباري عمل رائع وممتاز .. جزاكم الله خير الجزاء تقبل وافر تقديري واحترامي