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

جرب أضف كلمة Ptrsafe بعد كلمة Declare >> إذا لم يفلح الأمر معك سأوافيك بالكود ليلاً إن شاء ربي

أخي الكريم الطلب غامش بعض الشيء ...يا حبذا لو أرفقت شكل النتائج المتوقعة ؟؟ وأين تريد النتائج ؟ هل في نفس عمود الضريبة الذي يحتوي على معادلة بالفعل؟ وما هو المنطق لعملية الطرح مع الرقمين 5.70 و 3.50؟؟

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

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

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

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

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

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

أخي الكريم إيهاب جرب الملف التالي عله يكون المطلوب بعد استيراد الأسماء عن طريق زر الامر انقر في خلايا العمود F10 لتظهر قائمة منسدلة وعند الاختيار يتم إنشاء قائمة متناقصة .. Import Data YK.rar

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

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

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

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

أخي الكريم أيمن هل اشتغل معك الكود بشكل جيد ؟؟؟ أشك في النتائج ... راجع الملف مرة أخرى ... أخي الغالي ياسر العربي .. ركز معايا في اللي جاااااي إنت بتقول المشرفين بيقفشوا على Activate أو Select .. اتفضل القفش في الكود القفشة الأولى زي ما أبطلت تحديث الشاشة كان عليك ترجع الإعدادات مرة تانية وتشغل الخاصية في النهاية Application.ScreenUpdating = True القفشة التانية عند نسخ الكود .. هناك خطأ في هذا السطر لديك aseel = WorksheetFunction.CountA(Sheets("تحويل داخلي).Range("a5:a9999")) + 4 حضرتك نسيت أقواس التنصيص عشان تقفل اسم ورقة العمل القفشة التالتة في نفس السطر الل فوق ..دا كدا بيجيب آخر صف به بيانات ..يعني لما تيجي تلصق البيانات فيه آخر سطر سيتم اللصق عليه (قفشة في الجون) وليه اللفة الطويلة دي واستخدام دالة Counta وتزود عليها 4 كان ممكن يكون السطر بهذا الشكل أفضل aseel = Sheets("تحويل داخلي").Cells(Rows.Count, "B").End(xlUp).Row + 1 القفشة الرابعة بدلاً من أن تكتب وتشير إلى ورقة العمل Sheets("تحويل داخلي") الأفضل الإعلان عن متغير باسم ورقة العمل مرة في أول الكود لسهولة استخدام المتغير بمعنى أن تضع في أول الكود هذين السطرين Dim SH As Worksheet Set SH = Sheets("تحويل داخلي") وبعد ذلك يمكنك استخدام المتغير SH القفشة الخامسة حضرتك بتتسخدم أسماء أشخاص في المتغيرات ودا شيء مش مستحب لأن اسم المتغير بيعبر عن وظيفته في الغالب (دا أفضل) ..صحيح مش قفشة صحيحة بنسبة 100% ، ولكن أنا بكلم واحد محترف ، يعني لازم تستخدم اسماء في المتغيرات تعبر عن المتغير وعن نوعه كمان يعني مثلاً المتغير mohamed المفروض إنه بيجيب رقم آخر صف في ورقة العمل اللي فيها الكود ... كان ممكن نسميه lRow (حرف الـ l اختصار للنوع Long .. أو لو حبيت تستخدم Integer يبقا iRow) .. والمتغير المسمى aseel المفروض بيعبر عن آخر صف في ورقة العمل "تحويل الداخلي" أو على الأدق أول صف فارغ بعد آخر صف به بيانات ... ممكن تسميه iRowTar أي آخر صف في الورقة الهدف (الورقة الهدف : الورقة المراد الترحيل إليها) القفشة السادسة يفضل أيضاً الإشارة إلى ورقة العمل الحالية .. عشان تقدر تنفذ الكود من أي مكان تاني (لأن الكود بهذا الشكل مينفعش يتنفذ غير وإنت واقف في ورقة العمل Sheet1 فالأفضل تعيين متغير تاني لورقة العمل الأولى عشان تقدر تنفذ الكود من أي مكان زي ما قلت فيكون بهذا الشكل أيضاً .. Dim WS As Worksheet Set WS = Sheets("Sheet1") والأفضل كمان إنك تستخدم الاسم البرمجي بدلاً من اسم ورقة العمل ، نظراً لأن المستخدم قد يرغب في كثير من الأحيان إلى تغيير اسم ورقة العمل ، بالتالي راعي هذه النقطة أيضاً القفشة السابعة السطر التالي ايه لازمته ...عايز أعرف ايه الفايدة منه بعد انتهاء أسطر الكود aseel = aseel + 1 ملوش لازمة إلا لو كنت داخل حلقة تكرارية مثلاً وتريد زياد رقم الصف بمقدار واحد شفت إزاي ممكن كود صغير نقفش منه سبع قفشات ... قول ورايا : خشب السقف سبع خشبات واتمسكت بسبع قفشات (قولها 10 مرات) تقبل تحياتي أخوك وحبيبك أبو البراء الكود بالشكل النهائي يمكن أن يكون بهذا الشكل ... Sub Rectangle1_Click() Dim WS As Worksheet, SH As Worksheet Dim lRow As Long, lRowTar As Long Set WS = Sheet1: Set SH = Sheet5 lRow = WS.Cells(Rows.Count, "A").End(xlUp).Row lRowTar = SH.Cells(Rows.Count, "A").End(xlUp).Row + 1 Application.ScreenUpdating = False WS.Range("A2:H" & lRow).Copy SH.Range("A" & lRowTar).PasteSpecial Paste:=xlPasteValues Range("A1").CurrentRegion.Offset(1).ClearContents Application.ScreenUpdating = True End Sub

لا يشترط أخي نايف الضغط على إنتر ، يكفي الخروج من التكسب بوكس وتنشيط تكست بوكس آخر أو أي Control على الفورم اكتب على سبيل المثال أي نص في التكست بوكس الاول ومن خلال الماوس انقر في التكست بوكس الثاني

المشكلة في استخدام Select و Activate على ما أعتقد لذلك حاول الابتعاد عن التحديد وستجد الأمور تسير بشكل طبيعي فيدلاً من استخدام Activate لتحديد أو تنشيط الورقة ، يكفي أن تشير إليها هكذا ... Sheets("Sheet1").Range("A1:C15").Copy بدلاً من أن تستخدم الطريقة التالية Sheets("Sheet1").Activate Range("A1:C15").Copy

أخي الحبيب سليم بارك الله فيك على إثراء الموضوع ، ولكن الكود لا يعطي نتائج صحيحة يرجى مراجعة الكود أخي الحبيب أبو يوسف كما ذكر أخونا الغالي الخباز المحترف ياسر العربي .. كلنا هنا لازم نعجن لحد ما الخبز يطلع في أحسن صورة بالعكس أنا مبسوط جداً بمشاركتك ..لازم عشان تتعلم لازم تشارك وتغلط وتحاول وتفشل وتمشي وتقع وتقوم تقف تاني (هكذا يكون التعلم) ... لا أن نركن في جنب ونستنى دايماً المعلومة الجاهزة .. وبالمشاركات الكل بيتطور وبيتقدم ويتعلم وأنا أولكم والله .. أنا أبحث عن أكثر من حل حتى لو كان لدي حل .. فالبحث يزيد المعرفة ويوثق عملية التعلم إليكم هذا الكود أيضاً ليؤدي الغرض وهو أسرع بكثير (جرب اأن تضع الآف البيانات في العمود الاول ونفذ الكود وستجد الفرق) Sub ExtractNumber() Dim X, SP, I As Long With Range("A1", Cells(Rows.Count, 1).End(xlUp)) X = Application.Trim(.Value) For I = 1 To UBound(X) SP = Split(X(I, 1)) X(I, 1) = Val(Val(SP(3)) & "." & SP(2)) Next I .Offset(0, 1).Value = X End With End Sub تقبلوا تحياتي

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

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

أخي الحبيب عمرو مشكور على مرورك العطر وكلماتك الطيبة أخي الحبيب أبو يوسف ماذا لو زادت الأرقام عن ثلاثة أرقام ؟ .. أمر آخر لما الضغط على Ctrl +Shift + Enter (هذه ليست معادلة صفيف) أرجو أن تتقبل النقد بصدر رحب .. وكلنا نتعلم من بعضنا البعض أبي الغالي عموماً هذه دالة معرفة بسيطة تؤدي الغرض إن شاء الله Function GetNumber(myStr As String) myStr = Replace(myStr, "المبلغ النهائي", "") GetNumber = Val(Split(Application.Trim(myStr))(1) & "." & Split(Application.Trim(myStr))(0)) End Function Tee V2.rar

أخي الكريم إيهاب الغريب طبعاً الملفات بهذا الشكل لا تعجبني (دا مجرد رأيي الشخصي ) ..اسألني ليه ؟ بقولك اسألني ليه؟ مش سامعك كويس بص يا أخ إيهاب لما تيجي تنسق ورقة عمل تنسق الجزء اللي فيه بيانات بس مش تنسق ورقة العمل بالكامل لأن دا هيخلي الملف تقيل جداً من غير داعي لاحظت إنك مثلاً مسطر لحد آخر عمود في الشيت ..طيب ليه ؟ هل التنسيق غير مقصود أم مقصود؟ طبعاً دا ممكن يكون سبب في عدم استجابة الأعضاء للموضوع سيبك من الرغي اللي ملوش لازمة (بكلم نفسي) بص يا سيدي ..طبعاً تم تحويل المصنف المسمى 2 إلى امتداد xlsm ليقبل الأكواد (دي اول نقطة) في الكود عملت إبطال لتحديث الروابط عشان كل شوية تيجي رسالة عايز تحدث البيانات ولا لا ... !! في الخلية A9 في المصنف المسمى 2 حضرتك طلبت وضع رقم الإدارة ... ضع رقم الإدارة وانقر على زر الأمر Import Data (دا كان الجزء الأول من طلبك) أما الجزء الثاني من طلبك فلم أفهمه بشكل جيد ..يرجى ضرب مثال بشكل النتيجة المتوقعة لتتضح الصورة (اعمل زوووووم على الطلب ZOOM IN مش ZOOM OUT) إليك الكود وأرجو أن يفي بالغرض Sub ImportData() Dim WB As Workbook, AB As Workbook Dim Rng As Range, RngFiltered As Range, R As Range, Area As Range Dim vArray, I As Long Application.DisplayAlerts = False Application.AskToUpdateLinks = False Application.ScreenUpdating = False Set AB = ActiveWorkbook Set WB = Workbooks.Open(ThisWorkbook.Path & "\1.xlsx", UpdateLinks:=False) With AB.Sheets("اطباءوتمريض") .Range("C10:C1000").ClearContents Set Rng = WB.Sheets("بيانات").Range("A1:D" & Sheets("بيانات").Cells(Rows.Count, "D").End(xlUp).Row) Rng.AutoFilter Field:=2, Criteria1:=.Range("A9") On Error Resume Next Set RngFiltered = Rng.Offset(1).Resize(Rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Not RngFiltered Is Nothing Then ReDim vArray(2 To Rng.Rows.Count, 1 To 1) I = 1 For Each Area In RngFiltered.Areas For Each R In Area.Rows I = I + 1 vArray(I, 1) = R.Cells(4).Value Next R Next Area .Range("C10").Resize(I, 1).Value = vArray End If WB.Close False End With Application.ScreenUpdating = True Application.AskToUpdateLinks = True Application.DisplayAlerts = True End Sub طبعاً الكود خد مني حوالي ساعة عشان أقدر ألبي الجزء الأول من طلبك فمتنسناش بدعوة بظهر الغيب (لا تبخل علينا) Import Data YK.rar

أخي الكريم عبد الله السعيد جرب الملف المرفق عله يفي بالغرض دمت على طاعة الله Tee V1.rar

أخي الكريم أبو جيداء ضع معادلة الصفيف التالية في الخلية H5 ثم اسحبها عبر الصفوف والأعمدة لا تنسى بعد إدراج المعادلة الضغط على Ctrl + Shift + Enter =SUM(IF(FREQUENCY(IF($B$2:$B$12=$G5,IF($C$2:$C$12=H$4,MATCH($A$2:$A$12,$A$2:$A$12,0))),ROW($A$2:$A$12)-ROW($A$2)+1),1)) تقبل تحياتي

أخي الحبيب زيزو العجوز أشكرك على كلماتك الرقيقة وشعورك الطيب ولكن اعلم أن المدح لا يعنيني في شيء ، إنما يعنيني فقط مروركم العطر وشعوركم الطيب نحوي وحبكم لي في الله

أخي الكريم من الأفضل إرفاق الملف للإطلاع عليه هل هناك حماية لورقة عمل معينة بكلمة سر أخرى غير كلمة Wael ..؟؟ قد يكون أحد الأسباب