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

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

قام بنشر

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

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

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

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 2 And Target.Column = 3 Then
        Application.EnableEvents = False
            Dim iRow
            iRow = Application.Match(Target.Value, Sheet1.Columns(1), 0)
            If IsNumeric(iRow) Then
                Target.Offset(, 1).Value = Sheet1.Cells(iRow, "B").Value
            End If
        Application.EnableEvents = True
    End If
End Sub

تقبل تحياتي

 

  • Like 2
قام بنشر

بعد اذن  الاخوة تفضل هذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 Then
        On Error Resume Next
        Dim myrg As Range
        Set myrg = ورقة1.Range("A1:B100")
        Target.Offset(, 1).Value = ""
        Target.Offset(, 1).Value = Application.WorksheetFunction.VLookup(Target.Text, myrg, 2, 0)
    End If
End Sub


اما بخصوص كود اخي الغالي ابو البراء 
قم بتعديل من    Sheet1     الى     ورقة 1     داخل الكود

حسب الموجود لديك

  • Like 3
قام بنشر

أعتذر عن الخطأ الوارد بخصوص Sheet1 بدلاً من ورقة1 حيث أنني أعمل على ملف عندي ومسميات أوراق العمل باللغة الإنجليزية .. وأنا أفضل استخدام المسميات الإنجليزية في أسماء أوراق العمل البرمجية حتى لا يحدث لبس في الأكواد .. ربما تعودت على ذلك

بخصوص الكود يعمل بشكل جيد لدي ولا أدري ما السبب في أنه لا يعمل لديك

عموماً قدمت لك حلول أخرى اختر منها ما يناسبك وطبقه على ملفك ..

 

  • Like 2

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

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

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

Important Information