المشاركة الأصلية كتبت بواسطة: tameryakout8483
 
المشاركة الأصلية كتبت بواسطة: salim
 
المشاركة الأصلية كتبت بواسطة: tameryakout8483
uote=YasserKhalil]يرجى تفصيل الموضوع ووضع مزيد من التفاصيل كما يرجى وضع ملف مرفق آخر تكون فيه البيانات أقل بحيث يمكن اختبار الأكواد 

وما المقصود بتحديث تلقائي .. هل أوراق العمل موجودة بالفعل؟ أم أنه مطلوب أن يتم إنشاء أوراق العمل في كل مرة؟؟

لابد من تحديد آلية العمل بشكل أكثر دقة أخي الكريم
 
 
اقتبـاس ،،
استاذي العزيز ياسر

الموجود بالملف هو قاعدة بياتات  موظفين والمطلوب هو عمل شيت ( اوراق عمل ) لكل مهنة مع نقل البياتات بمعنى انة لدي مثلافي الملف عدد 20 عامل دة مثلا اريد ان يتم نقل الموظفين الذين يعملون هذة المهنة مع بياناتهم من رقم ثابت رقم بطاقة وتاريخ ميلاد الخ وما اقصدة من تحديث لقائي هو عندما اقوم بتغير اي بيانات للموظفين في ورقة العمل الاصلية يتم ترحيل هذا التغير الي في اوراق العمل الاخري 

واخيرا ليس لدي ملف اخر لان هذا هو الملف هو قاعدة بيانات ولا اريد ان احذف اي بند به

وجزااك الله خيرا  بارك الله فيك أخي الحبيب وجزيت خيراً
 
 

يا أخي قم بارسال نموذج مصغر (10- 15 اسم)  من صفحة واحدة   اقول نموذج وليس الملف الحقيقى (فلنسميه ملف مزور)

 مع شرح ماذا تريد بالتفصيل

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

استاذ ياسر انا رفعت لك ملف مزور

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

جرب هذا الكود



Option Explicit

Sub filter_my()

Application.ScreenUpdating = False

If ActiveSheet.Name <> "مستر" Then GoTo THANK_YOU

Dim S_Sh As Worksheet: Set S_Sh = Sheets("مستر")

Dim x%, i%, st$: st = S_Sh.Cells(1, "f")

Dim My_name$

Dim Filt_Rg As Range

Dim Last_Row%: Last_Row = S_Sh.Cells(Rows.Count, 1).End(3).Row

Set Filt_Rg = S_Sh.Range("a1:h" & Last_Row)

         For i = 2 To Last_Row

            On Error Resume Next

            My_name = S_Sh.Cells(i, 6)

             x = Len(Sheets(My_name).Name)

                If x = 0 Then

                Sheets.Add(, ActiveSheet).Name = My_name

                End If

         Next

  For i = 2 To Sheets.Count

   With Sheets(i)

        .Range("Ak1") = st

        .Range("Ak2") = Sheets(i).Name

         Filt_Rg.AdvancedFilter 2, .Range("ak1:ak2"), .Range("a1")

        .Columns("a:H").AutoFit

        .Range("Ak1") = vbNullString

        .Range("Ak2") = vbNullString

    End With

   Next

THANK_YOU:

   Application.ScreenUpdating = True

End Sub







الملف مرفق بدون  زركشات و مختصر (زركش فيما  بعد كما تريد و اضف الكود الى ملفك)

يجب الا يتجاوزعدد حروف  اسم كل ورقة  الرقم31 بما في ذلك المسافات ( الدكتور اكسل لا يرضى بهذا)
 

 

 
المشاركة الأصلية كتبت بواسطة: tameryakout8483
uote=YasserKhalil]يرجى تفصيل الموضوع ووضع مزيد من التفاصيل كما يرجى وضع ملف مرفق آخر تكون فيه البيانات أقل بحيث يمكن اختبار الأكواد 

وما المقصود بتحديث تلقائي .. هل أوراق العمل موجودة بالفعل؟ أم أنه مطلوب أن يتم إنشاء أوراق العمل في كل مرة؟؟

لابد من تحديد آلية العمل بشكل أكثر دقة أخي الكريم
 
 
اقتبـاس ،،
استاذي العزيز ياسر

الموجود بالملف هو قاعدة بياتات  موظفين والمطلوب هو عمل شيت ( اوراق عمل ) لكل مهنة مع نقل البياتات بمعنى انة لدي مثلافي الملف عدد 20 عامل دة مثلا اريد ان يتم نقل الموظفين الذين يعملون هذة المهنة مع بياناتهم من رقم ثابت رقم بطاقة وتاريخ ميلاد الخ وما اقصدة من تحديث لقائي هو عندما اقوم بتغير اي بيانات للموظفين في ورقة العمل الاصلية يتم ترحيل هذا التغير الي في اوراق العمل الاخري 

واخيرا ليس لدي ملف اخر لان هذا هو الملف هو قاعدة بيانات ولا اريد ان احذف اي بند به

وجزااك الله خيرا  بارك الله فيك أخي الحبيب وجزيت خيراً
 
 

يا أخي قم بارسال نموذج مصغر (10- 15 اسم)  من صفحة واحدة   اقول نموذج وليس الملف الحقيقى (فلنسميه ملف مزور)

 مع شرح ماذا تريد بالتفصيل

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

 سيدي الكريم

لعمل الكود 

1- قم بتغيير اسم الصفحة  "Transfer" الى "salim"

2- قم بادراج صفحة جديدة تحت اسم "Sapace"  يمكن اخفائها 
 لعمل الكود 
 1-  يجب تغيير اسم الصفحة  "Transfer" الى "salim"
 2-  ادراج صفحة جديدة تحت اسم "Sapace"  يمكن اخفائها   أو وضعها "Verryhidden "  كما فعلت انا بالرد في نفس المنتدى

 
 
 
 
[quote = Excelawy] Professor Ali Muhammad Peace and mercy of God When I try to call data the attached error occurs [/ quote]
 
 
 

 اخي ياسر اعتقد

ان حقوق النشر محفوظة

لذا ارجوالايعاز الى  صاحب المشاركة  ادراج اسم واضع الكود على هذا العنوان
 لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب 
 
 
 
[quote = YasserKhalil] You do not have a worksheet in the image named salim Change the name of the worksheet ... so it is in your file [/ quote]
 
 
 

 
المشاركة الأصلية كتبت بواسطة: YasserKhalil
أخي الحبيب سليم

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

 
 

ايه الكرم ده كلّو "نجمة "وحدة وخلاص

على كل حال القناعة من الإيمان (مش بس النظافة)

 احد الحلول الاخرى

   عندي سؤالين ارجو الاجابة:

1- ما هي هذه الاشارة <> التي تظهر في الزاوية  العليا اليسرى من نافذة الكود بعد ارساله

2- هل يمكن جعل نافذة الكود مطاطة بحيث يستطيع الانسان قراءة اكثر من 6 او 7 اسطر من الكود

     لأنك عتدما تقرأ فقط قسم من الكود الطويل لا تتذكر ما ورد في البداية و لا يمكن تخمين النهاية

           (حتى و لو استعملت مقبض الانزلاق)



Sub M_Salim()

Dim i%: i = 2

Do Until Range("a" & i) = vbNullString

Debug.Print Range("a" & i)

i = i + 1

Loop

End Sub

'==========================

Sub M_Salim1()

Dim i%: i = 2

Do

Debug.Print Range("a" & i)

i = i + 1

Loop Until Range("a" & i) = vbNullString

End Sub


 

 

 
المشاركة الأصلية كتبت بواسطة: YasserKhalil
بارك الله فيك أخي الحبيب سليم ..

كود رائع وممتاز .. وطريقتك مميزة وسهل فهمها
 

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

 
 

الى اي متى سوف أبقى عضو بـــ"نجمة واحدة"      

 اخي الحبيب ياسر
 اعذرني

لا استطيع الا ان ارد بكود مماثل يؤدي نفس الوظيفة

الكود ضمن هذا الملف

 

 
المشاركة الأصلية كتبت بواسطة: YasserKhalil
وعليكم السلام

جرب الكود التالي عله يفي بالغرض إن شاء الله

Sub TestYasser()

    Dim x           As Variant

    Dim y           As Variant

    Dim r           As Long



    Application.ScreenUpdating = False

        For r = 3 To Cells(Rows.Count, 1).End(xlUp).Row

            x = Application.Match(Cells(r, 1).Value, Columns(2), 0)

            If Not IsError(x) Then Cells(r, 4).Value = Cells(x, 2).Value

            y = Application.Match(Cells(r, 2).Value, Columns(1), 0)

            If IsError(x) Then Cells(r, 2).Interior.Color = vbCyan

        Next r

    Application.ScreenUpdating = True

End Sub


 

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

بارك الله بك اخي ياسر

ولكن لا اظن ان الموضوع يحاجة الى كود 

فقط هذه المعادلة



=IFERROR(INDEX($B$2:$B$8,MATCH(A2,$B$2:$B$8,0)),B2)

 يمكن استعمال هذه المعادلة توضع في الخلية D2 ,وتسحب نزولاً



=IFERROR(INDEX($B$2:$B$8,MATCH(A2,$B$2:$B$8,0)),B2)



 

 
المشاركة الأصلية كتبت بواسطة: Eslam Abdullah
هناك ملاحظة ارجوا انت تاخذها بصدر رحب

المعادله تستنج من رقم 1 انه عدد اولى اضافة لاستنتاج انه له قاسمان

تعريف الاعداد الاوليه هى الاعداد التى لها عاملان فى القسمة فقط ورقم 1 له عامل واحد وهو نفسه لذلك لا يعد عدد اولى

اصغر الاعداد الاوليه هو الرقم الزوجى الاولى الوحيد الرقم 2 لتحقيقه شرط العاملان فقط

ومن مميزات الارقام الاوليه انها تمتد الى ما لانهايه ويمكن تحديدها بخوارزميات عديده

وقد قمت بكتابة معادله واستخدمت احدى الخوارزميات وهى ابسطها وابطأها

وتتمثل فى قسمة هذا العدد على الاعداد المحصورة بين 2 والجذر التربيعى ولا ينبغى الاستكمال لناتج القسمه على 2 لاكتشاف الامر

واقدم هذا الحل للاستفادة اكثر ونصيحة اخرى حاول الاختصار اكثر فى كتابة الصيغ

للتحميل لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

تحياتى لشخصك الكريم
 
 
 شكراً لك اسالذ اسلام على هذه المعلومة

لكن احب ان الفت نظركم ان 

قسمة  العدد على الاعداد المحصورة بين 2 والجذر التربيعى له (تعطينا بعض القواسم  فقط لهذا العدد ) وليس كل قواسمه 

بينما القسمة على الاعداد المحصورة بين 2 و (  نصف العدد اذا كان مزدوجاً    او نصف (العدد+1) اذا كان مفرداً) تعطينا كل القواسم

مثلاً

قسمة العدد 18 على الاعداد من 2 الى 4 (تقريب الجذر التربيعى ) تعطينا 9 / 6 / 4.5 

قسمة العدد 18 على الاعداد من 2 الى 9 (نصف 18) تعطينا  9 / 6 / 4.5 / 3.6 / 3 /  ...... /2

لهذا السبب انا أخذت الدالة   Int(A2/2)+1 

                        وليس    Int(SQRT(a2))+1

 

 في هذه الحالة تأتي الدّالة Mod  لتقوم بعملها
  

وفي النهاية تعريف اكثر دقة للعدد الاّولي

تعريف: العدد الأوّلي هو عدد طبيعي (دون فواصل) ,أكبر من 1  وله  قاسمان فقط  

            ملاحظة : اذا لم يكن أوليّاً من الطبيعي ان عدد قواسمه أكبر من 2 

 

 
المشاركة الأصلية كتبت بواسطة: YasserKhalil
بارك الله فيك أخي الحبيب سليم وجزاك الله كل خير

لك يسعدني أن أرى مشاركاتك الفعالة والمميزة في المنتدى والتي تثري المنتدى بشكل كبير فأنت علم من أعلام الإكسيل في الوطن العربي

وفقني الله وإياك لكل خير
 

شكراً اخي الكريم ياسر و وفقك الله

ولكني أعجب لأمر يحيّرني:

كيف يكون عدد المعجبين 3 و عدد مرات تحميل الملف 2 (فهل نشتري السمك في البحر؟؟)