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

المغفوري · أكتوبر 27

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

image.png.57f8aa6fdf39f3f6513ce9ab1264b3e0.png

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

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

نبا زيد · أكتوبر 27

السلام عليكم

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

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

تم تعديل أكتوبر 27 بواسطه صباح2024

**محمد هشام.** · أكتوبر 27

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

في الخلية 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

تم تعديل أكتوبر 27 بواسطه محمد هشام.

المغفوري · أكتوبر 29

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

**محمد هشام.** · أكتوبر 29

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

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

تم تعديل أكتوبر 29 بواسطه محمد هشام.

المغفوري · أكتوبر 29

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

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

**محمد هشام.** · أكتوبر 29

ادن جرب هدا

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

تم تعديل أكتوبر 30 بواسطه محمد هشام.