معاناتي مع دالة vlookup مع ملف متابعة الطلاب

[المغفوري]

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

 

أرجو المساعدة 

متابعة الطلاب.xlsx

[صباح2024]

السلام عليكم

ان شاء الله هذا طلبك

 

 

 

متابعة الطلاب1.xlsm

تم تعديل الأحد at 18:10 بواسطه صباح2024

[محمد هشام.]

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

في الخلية A4  ضع احدى المعادلات التالية مع سحبها يسارا لغاية عمود L وسحبها أسفل لغاية الصف الدي يناسبك 

=IFERROR(INDEX('بيانات الطلاب'!A$3:A$100, SMALL(IF('بيانات الطلاب'!$B$3:$B$100=$B$1,
ROW('بيانات الطلاب'!$B$3:$B$100)-ROW('بيانات الطلاب'!B$3)+1), ROW(1:1))), "")

أو 

=IFERROR(INDEX('بيانات الطلاب'!A$3:A$100, AGGREGATE(15, 6, ROW('بيانات الطلاب'!$B$3:$B$100)
-ROW('بيانات الطلاب'!B$3)+1/( 'بيانات الطلاب'!$B$3:$B$100=$B$1), ROW(1:1))), "")

أو 

=FILTER('بيانات الطلاب'!A$3:A$100, 'بيانات الطلاب'!$B$3:$B$100 = $B$1)

 

متابعة الطلاب.xlsx

باستخدام الأكواد 

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d As Long, j As Long, clé As String, IRow As Long, col As Long
    Dim WS As Worksheet: Set WS = Worksheets("بيانات الطلاب")
    Dim F As Worksheet: Set F = Worksheets("متابعة الطلاب")

    If Not Intersect(Target, Me.Range("B1")) Is Nothing Then
        d = 4
        clé = F.Range("B1").Value
        IRow = WS.Range("B3:B" & WS.Rows.Count).Find("*", _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        Application.ScreenUpdating = False
        F.Range("A4:L" & F.Rows.Count).ClearContents
        For j = 3 To IRow
            If WS.Cells(j, 2).Value = clé Then
                For col = 1 To 12
                    F.Cells(d, col).Value = WS.Cells(j, col).Value
                Next col
                d = d + 1
            End If
        Next j
        Application.ScreenUpdating = True
    End If
End Sub

 

متابعة الطلاب.xlsb

تم تعديل الأحد at 19:37 بواسطه محمد هشام.

[المغفوري]

هل استطيع التعديل على البيانات في ورقة متابعة الطلاب بعد جلبها من ورقة بيانات الطلاب ام ان ورقة متابعة الطلاب عبارة عن استعلام؟ 

[محمد هشام.]

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

Option Explicit
Sub UpdateData()
    Dim WS As Worksheet, F As Worksheet, i As Long, j As Long
    Dim n As Boolean

    Set WS = Worksheets("بيانات الطلاب")
    Set F = Worksheets("متابعة الطلاب")
    
    If F.Cells(F.Rows.Count, 1).End(xlUp).Row < 4 Then Exit Sub

    Application.ScreenUpdating = False
    n = False

    For i = 4 To F.Cells(F.Rows.Count, 1).End(xlUp).Row
        For j = 3 To WS.Cells(WS.Rows.Count, 1).End(xlUp).Row
            If WS.Cells(j, 1).Value = F.Cells(i, 1).Value Then
                WS.Cells(j, 2).Resize(, 10).Value = F.Cells(i, 2).Resize(, 10).Value
                n = True
                Exit For
            End If
        Next j
    Next i

    Application.ScreenUpdating = True
    
    If n Then
        MsgBox "تم التعديل بنجاح", vbInformation, "تأكيد"
    End If
End Sub

 

 

 

متابعة الطلاب.xlsb

تم تعديل الثلاثاء at 15:03 بواسطه محمد هشام.

[المغفوري]

تظهر رسالة خطأ run time "9" error

تظهر رسالة خطأ كما هو موضح في الصورة 

[محمد هشام.]

ادن جرب هدا 

Option Explicit
Sub UpdateData()
    Dim WS As Worksheet, F As Worksheet
    Dim i As Long, j As Long, a As Long
    Dim Clé As Long, found As Boolean, modified As Boolean

    Set WS = Sheet1      ' <<=== ' 'Worksheets("بيانات الطلاب")
    Set F = Sheet3       ' <<=== ' 'Worksheets("متابعة الطلاب")
    Clé = 1              ' <<=== ' الاسم ( يمكنك تعديله بما يناسبك )' عمود الشرط

    Application.ScreenUpdating = False
    modified = False

    For i = 4 To F.Cells(F.Rows.Count, Clé).End(xlUp).Row
        Dim tmp As String: tmp = F.Cells(i, Clé).Value
        found = False
        
        For j = 3 To WS.Cells(WS.Rows.Count, Clé).End(xlUp).Row
            If WS.Cells(j, Clé).Value = tmp Then
                For a = 2 To 12
                    WS.Cells(j, a).Value = F.Cells(i, a).Value
                Next a
                found = True
                modified = True
                Exit For
            End If
        Next j
        
        If Not found Then
            Debug.Print "No match for: " & tmp
        End If
    Next i

    Application.ScreenUpdating = True
    If modified Then MsgBox "Updated successfully", vbInformation
End Sub

 

تم تعديل بالامس في 01:10 بواسطه محمد هشام.

[المغفوري]

لم يعمل الكود وتظهر رسالة خطأ برموز غير عربية واذا اخترت الصف لا تظهر بيانات الطلاب في ورقة متابعة الطلاب

[محمد هشام.]

أخي @المغفوري 

1 ) الرموز الظاهرة معك ليست خطأ هده رسالة (تم التعديل بنجاح ) لحل مشكلة طلاسم اللغة العربية عليك مراجعة  ظبط اعدادات اللغة العربية على جهازك 

2) الكود مفاده  إذا تم العثور على مطابقة للإسم  يتم تحديث  البيانات (من العمود B إلى  L )   

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

 

 

متابعة الطلاب.xlsb

تم تعديل بالامس في 01:44 بواسطه محمد هشام.