اذهب الي المحتوي
أوفيسنا

استبدال الادوار


إذهب إلى أفضل إجابة Solved by أ / محمد صالح,

الردود الموصى بها

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

استبدال الادوار.xls

رابط هذا التعليق
شارك

  • أفضل إجابة

عليكم السلام و رحمة الله وبركاته 

الجزء الثاني من المطلوب غير منطقي

حيث سيظل الكود في حلقة من الأحداث لا تنتهي

فمثلا تم تغيير الدور الاول إلى الثالث

فيفترض من الكود أن يبحث عن موظف الدور الثالث ويضعه في الدور الأول

وحينها يتم استدعاء كود حدث التغيير لأن خلية الدور الثالث تغيرت في العمود E 

وساعتها يبدأ في البحث وهكدا

والحل في هذه المشكلة كتابة التغيير المطلوب في العمود G مثلا بالكود

ويتم كتابته مرة أخرى يدويا في العمود E

مع تعديل حدث التغيير إلى هذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("e8:e100")) Is Nothing Then Exit Sub
lr = Range("h" & Rows.Count).End(xlUp).Row + 1
Cells(lr, "h") = Target.Offset(0, -2)
Cells(lr, "i") = [k1]
Cells(lr, "j") = Target.Value
lr1 = Range("e" & Rows.Count).End(xlUp).Row
If Target.Offset(0, 2) = "" Then
For n = 8 To lr1
If n <> Target.Row And Cells(n, 5) = Target.Value And Cells(n, 4) = Target.Offset(0, -1) And Cells(n, 6) <> "راحة" Then Cells(n, 7) = [k1]
Next n
Else
Target.Offset(0, 2) = ""
End If
End Sub

بالتوفيق 

  • Like 1
رابط هذا التعليق
شارك

استاذ محمد صالح رجل المهام الصعبة ادعوا من الله عز وجل أن يزيدكم علما ومعرفة وان يتجاوز عن سيئاتنا ويغفر لنا وللمسلمين اجمعين وبارك الله فيكم وصلى اللهم على سيدنا محمد صلى الله عليه وسلم 

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information