تعبئة خلايا بناء على قيمة خلية اخرى

[ابو راكان العودة]

السلام عليكم 

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

مرفق ملف يوضح المطلوب وجزاكم الله خير 

try50-100.rar

[سليم حاصبيا]

وجدت لك الحل بشرط كتابة 1 أو 2 في عامود اخر (K)

try50-100 salim.zip

[ابو راكان العودة]

اهلا استاذ سليم وشكر للمساعدة الله يجزاك خير

لكن اظن الطريقة ممكن تنجح عن طريق الفجول بيسك 

حاولت ونجحت لكن المشكلة يحتاج عدة معادلات ظويلة لكل خلية

عجزت اجد المعادلة الصحيحة المختصررة 

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

أخي الكريم أبو راكان

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

كليك يمين على اسم ورقة العمل ثم اختر View Code ثم الصق الكود التالي

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("B1:I15")) Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
            If Target = 1 Then
                Range(Cells(Target.Row, "B"), Cells(Target.Row, "I")) = 50
                Target = 1
            ElseIf Target = 2 Then
                Range(Cells(Target.Row, "B"), Cells(Target.Row, "I")) = 100
                Target = 2
            End If
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End Sub

عند حفظ المصنف يجب الحفظ بامتداد xlsm للحفاظ على الأكواد التي تم إدراجها

لمزيد من التفاصيل يمكنك الإطلاع على موضوع "بداية الطريق لإنقاذ الغريق" لطائر البطريق ياسر خليل

تقبل تحياتي

[ابو راكان العودة]

الاخ المشرف الغالي ياسر ابو البراء 

تسلم ايديك وجزاك الله خير هذا هو المطلوب الله يحفظك وينور قلبك بالايمان 

[سليم حاصبيا]

بعد أذن اخي الغالي ياسر

و اثراءً للموضوع اسمحوا لي بأن اتدخل بهذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.ScreenUpdating = False
 
 If Not Intersect(Target, Range("b1:i15")) Is Nothing And Target.Count = 1 Then
        all_rows
        GoTo 1
  End If
1:
  Application.ScreenUpdating = True
 End Sub
 
Sub all_rows()
 Dim My_first_nb As Integer
 Dim My_sec_nb As Integer
 Dim Myrg As Range
  Set Myrg = Range("b1:i15")
  My_first_nb = 1
  My_sec_nb = 2
 For Each cel In Myrg
  If cel.Value = My_first_nb Then
   Cells(cel.Row, 2).Resize(1, 8) = 50
   ElseIf cel.Value = My_sec_nb Then
   Cells(cel.Row, 2).Resize(1, 8) = 100
   End If
   Next
 End Sub

 

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

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

الكود الخاص بك يقوم بتعبئة الصف بنفس الرقم 50 أو 100 حسب القيمة المدخلة 1 أو 2 .. ولكن لاحظت في النتائج المرفقة من قبل أخونا أبو راكان أنه يريد أن تكون النتاج كما طبقت ما عدا الخلية التي يكتب فيها القيمة 1 أو 2

جرب الكودين لتتأكد من المطلوب

تقبل وافر تقديري واحترامي

 

[ابو راكان العودة]

اخواني الله يجزاكم خير ولا يحرمنا منكم 

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

أخي الكريم أبو راكان

هل جربت كلا الكودين ؟ وهل الكودين يؤديان نفس الغرض بالنسبة لك ...؟