قائمة منسدلة تعتمد على شيت اخر

[gamalin]

اخواني الاعزاء اكرمكم الله

مرفق ملف به 2 شيت بالاول بيانات والثاني به جدول

مطلوب

عمل قائمة منسدلة في خانة رقم اذن الدخول

وبمجرد اختيار رقم الاذن من المتاح بشيت 1 يتم استكمال باقي بيانات الجدول في شيت 2

وبعدها يتم اما حذف السطر من شيت 1

او تلوين السطر

او كتابة تم في عمود الاستخدام

اريد الثلاثة بدائل لاختيار ايها انسب في مشروعي الجديد

ارجوا ان يكون طلبي واضح

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

وايضا اخي عمر وكل الزملاء يسعدني ان يهتموا بهذا الموضوع

new.rar

[gamalin]

ولا رد ياترى هل السؤال غير واضح ام انه يحتاج لوقت ؟

[beho2000]

بس خلينا نشوف الموضوع شوي

تسلــــــــــــــــــــــــــــــــــــــــــــم

[نزار سليمان عيد]

اخي الكريم السلام عليكم

المرفق للبديل الثاني وهو كلمة تم

انظر للمرفق

new_2.rar

[gamalin]

اخي جزاك الله خيرا قطعا شوطا طيبا

اولا القائمة تمام

لكن كلمة تم المفروض انها تعني ان هذا الاذن تم استخدامه يعني value ولا تتغير بتغير الاختيارات

شكرا على هذا الجهد الطيب وامل في المواصلة جزاك الله خيرا

[ابو اسامة العينبوسي]

السلا م عليكم

تم اضافه الحذف او التلوين الى طلبك

new5.rar

[gamalin]

السلا م عليكم

تم اضافه الحذف او التلوين الى طلبك

استاذي الفاضل بارك الله فيك

الحذف شغال ومفيش اروع من كده ما تمنيت افضل من ذلك لكني لم اعرف كيف يمكن التلوين فبمجرد اختيار اذن الدخول يتم جلب بياناته وحذفه

اشكرك ولو امكن ان معالجة باقي البدائل اكون شاكر لك جدا

[gamalin]

السلا م عليكم

تم اضافه الحذف او التلوين الى طلبك

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

بقي لو وقتكم الكريم يسمح البديل الاول وهو كتابة كلمة تم فقط بس تكون value وليست معادلة وتتغير كلما حدث تغيير

ولك مني وافر التحية والاحترام واتمنى ان يكون بهذا الكود فائدة لكثير من الاخوة بالمنتدى

[ابو اسامة العينبوسي]

Sub ocolor()
Dim myrng As Range
Dim cell As Range
Dim myrows As Integer
Sheets(1).Activate
myrows = Range("A65000").End(xlUp).Row
Set myrng = Range(Cells(2, 1), Cells(myrows, 1))
For Each cell In myrng
If cell.Value = Sheets(2).Cells(3, 2).Value Then
cell.EntireRow.Interior.ColorIndex = 5
cell.Offset(0, 7).Value = "تم"
End If
Next
Sheets(2).Activate
End Sub

[gamalin]

Sub ocolor()
Dim myrng As Range
Dim cell As Range
Dim myrows As Integer
Sheets(1).Activate
myrows = Range("A65000").End(xlUp).Row
Set myrng = Range(Cells(2, 1), Cells(myrows, 1))
For Each cell In myrng
If cell.Value = Sheets(2).Cells(3, 2).Value Then
cell.EntireRow.Interior.ColorIndex = 5
cell.Offset(0, 7).Value = "تم"
End If
Next
Sheets(2).Activate
End Sub

لا اجد افضل من جزاك الله خيرا ونفعك ونفع بك ورضي عنك وارضاك وهنأك بالقبول

اشكرك ليس هناك ابدع ولا ايسر من ذلك

[gamalin]

اخي ابو اسامة هل لي ان اطمع في ان يكون الكود بدلا من تنفيذه مع التغيير في الشيت مع تغيير الخلية في مدى محدد

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

new5.rar

[gamalin]

للرفع

[gamalin]

اخي ابو اسامة

رجاء بحث هذا الامر او الرد وكذلك باقي الاخوة الكرام

[gamalin]

3

[ابو اسامة العينبوسي]

هذا و ليس الذى ارسلته لك على المسنجر

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row < 5 Or Target.Row > 65 And Target.Column <> 3 Then Exit Sub
 Call odelete
End Sub

تم تعديل مايو 23, 2008 بواسطه ابو اسامة العينبوسي

[ابو اسامة العينبوسي]

هذا و ليس الذى ارسلته لك على المسنجر

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row < 5 Or Target.Row > 65 And Target.Column <> 3 Then Exit Sub
 Call odelete
End Sub

تم تعديل مايو 23, 2008 بواسطه ابو اسامة العينبوسي

[gamalin]

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

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

اخي اعتقد ان البطئ في في الكود لدي نابع من السطر التالي

For Each cell In Sheets("فواتير ").Range("b2:b65500")

لانه حتى بعد ان يجد قيمة ويستكمل البيانات يظل ينفذ الحلقة الى نهاية المدى b2:b65500 هذا وفق فهمي فاعذرني فهل هذا صحيح

وان كان صحيح فهل يمكن جهل الحلقة تتوقف بمجرد ان يجد قيمة ويأتي ببياناتها

ملاحظة الكود كامل في الاسطر التالية ولكم وافر التحية والاحترام

Sub onChange()

Dim cell As Range

Dim myt As Range

Application.EnableEvents = False

For Each cell In Sheets("فواتير ").Range("b2:b65500")

For i = 1 To 13

Set myt = Range("c63").End(xlUp)

If myt.Value = cell.Value Then

myt.Offset(0, i).Value = cell.Offset(0, i + 2).Value

myt.Offset(0, -1).Value = myt.Row - 13

End If

Next

Next

Application.EnableEvents = True

End Sub

تم تعديل مايو 24, 2008 بواسطه gamalin

[gamalin]

اخي ابو اسامة اشكرك شكرا كثيرا

تمكنت من تعديل الكود ليصبح كالتالي ويعمل بنجاح اشكرك

Sub onChange()

Dim cell As Range

Dim myt As Range

Application.EnableEvents = False

For Each cell In Sheets("ÝæÇÊíÑ ").Range("b2:b65500")

Set myt = Range("c63").End(xlUp)

If myt.Value = cell.Value Then

For i = 1 To 13

myt.Offset(0, i).Value = cell.Offset(0, i + 2).Value

myt.Offset(0, -1).Value = myt.Row - 13

Next

Exit For

End If

Next

Application.EnableEvents = True

End Sub