طلب تعديل تلقائي للبيانات

[أبو يحيى الجبلاوي]

السلام عليكم ورحمة الله وبركاته أخواني الكرام الأفاضل حياكم الله وبعد 
أرجو منكم مساعدتي فيما يلي :
لدي ملف اكسيل من 2 sheets 
الأول يوجد فيه data
وثانية هو محتويات لعمل خلية كقائمة 
اريد عند تعديل محتويات القائمة ان يتم تعديل جميع الخلايا ذات نفس القيمة ب sheets data 
أرفق لكم صورة توضيحية + ملف مرفق

تعديل تلقائي للبيانات.zip

[ابو علي و سدرة]

الملف المرفق غير موجود

برجاء ارفاق الملف مرة اخرى

 

[أبو يحيى الجبلاوي]

اعتذر منكم الملف مرة اخرى 

تعديل تلقائي للبيانات.zip

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

جرب الكود التالي في حدث ورقة العمل

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row > 1 And Target.Column = 3 Then
        Application.EnableEvents = False
            Range("Z1").Value = Target.Value
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 1 And Target.Column = 3 Then
        Sheets("list").Columns(6).Replace What:=Range("Z1").Value, Replacement:=Target.Value, LookAt:=xlWhole
    End If
End Sub

 

[أبو يحيى الجبلاوي]

منذ ساعه, ياسر خليل أبو البراء said:

جرب الكود التالي في حدث ورقة العمل

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row > 1 And Target.Column = 3 Then
        Application.EnableEvents = False
            Range("Z1").Value = Target.Value
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 1 And Target.Column = 3 Then
        Sheets("list").Columns(6).Replace What:=Range("Z1").Value, Replacement:=Target.Value, LookAt:=xlWhole
    End If
End Sub

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

 

اخي ياسر الكود يعمل بالمقلوب 
انا اريد عند التغيير في الصفحة list 

انا تتغير جميع المعلومات التي لها نفس القيمة في الصفحة DATA

 

 

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

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

[أبو يحيى الجبلاوي]

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

 

14 دقائق مضت, ياسر خليل أبو البراء said:

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row > 1 And Target.Column = 6 Then
        Application.EnableEvents = False
            Range("Z1").Value = Target.Value
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 1 And Target.Column = 6 Then
        Sheets("data").Columns(3).Replace What:=Range("Z1").Value, Replacement:=Target.Value, LookAt:=xlWhole
    End If
End Sub
 

[أبو يحيى الجبلاوي]

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

ارجو منك التكرم في حل هذا الموضوع

تم تعديل أكتوبر 19, 2016 بواسطه أبو يحيى الجبلاوي

[أبو يحيى الجبلاوي]

السلام عليكم هل من رد من أحد الاخوة

[أبو يحيى الجبلاوي]

الحمد لله تم حل الموضوع بإضافة صغيرة يمكن ليست بإحترافية بس هيك طلع معي 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row > 1 And Target.Column = 6 Then
        Application.EnableEvents = False
         If Target.Value = 0 Then
         Range("Z1").Value = "@#"
         Else
         Range("Z1").Value = Target.Value
         End If
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 1 And Target.Column = 6 Then
        Sheets("data").Columns(3).Replace What:=Range("Z1").Value, Replacement:=Target.Value, LookAt:=xlWhole
    End If
End Sub