پرسش لیست افراد با ویژگی خاص

[s.313]

سلام.
من یه بانک اطلاعاتی از دانش آموزای یه آموزشگاه دارم که چند درس مختلف تدریس میشه و هر کدوم از دانش آموزها ممکنه چندتا از این کلاسهارو شرکت کرده باشند و ممکنه بعضی کلاسهارو شرکت نکرده باشند.
حالا من میخوام در شیت ۲ امکان این باشه که در جای مشخص وقتی اسم درس خاصی رو مینویسم دانش آموزانی که درس خاصی مثل ریاضی را گذرانده اند رو برام لیست کنه.
در شیت ۳ هم بر عکس این.. اگر اسم شخص خاصی رو نوشتم اسم تمام دروسی که اون شخص پاس کرده برام لیست کنه.

[M_ExceL]

سلام.
من یه بانک اطلاعاتی از دانش آموزای یه آموزشگاه دارم که چند درس مختلف تدریس میشه و هر کدوم از دانش آموزها ممکنه چندتا از این کلاسهارو شرکت کرده باشند و ممکنه بعضی کلاسهارو شرکت نکرده باشند.
حالا من میخوام در شیت ۲ امکان این باشه که در جای مشخص وقتی اسم درس خاصی رو مینویسم دانش آموزانی که درس خاصی مثل ریاضی را گذرانده اند رو برام لیست کنه.
در شیت ۳ هم بر عکس این.. اگر اسم شخص خاصی رو نوشتم اسم تمام دروسی که اون شخص پاس کرده برام لیست کنه.

سلام،
به ترتیب برای شیت دوم و سوم، نام درس یا شخص رو داخل سلول a1 وارد کرده سپس کد های زیر رو اجرا کنید :
شیت دوم :

Sub test()
lrow2 = Sheets(2).Range("b" & Rows.Count).End(3).Row
Sheets(2).Range("b2:b" & lrow2).ClearContents
Sheets(2).Range("b1") = ChrW(1606) & ChrW(1575) & ChrW(1605) & ChrW(32) & ChrW(1588) & ChrW(1582) & ChrW(1589)
d = ChrW(1583) & ChrW(1575) & ChrW(1585) & ChrW(1583)
For i = 1 To 4
    If Sheets(2).Range("a1") = Sheets(1).Cells(1, i + 2) Then
        For j = 1 To 5
            If Sheets(1).Cells(j + 1, i + 2) = d Then
            Sheets(2).Range("b" & 1000).End(3).Offset(1) = Sheets(1).Cells(j + 1, 2)
            End If
        Next j
    End If
Next i
End Sub

شیت سوم :

Sub test2()
lrow2 = Sheets(3).Range("b" & Rows.Count).End(3).Row
Sheets(3).Range("b2:b" & lrow2).ClearContents
Sheets(3).Range("b1") = ChrW(1606) & ChrW(1575) & ChrW(1605) & ChrW(32) & ChrW(1583) & ChrW(1585) & ChrW(1587)
d = ChrW(1583) & ChrW(1575) & ChrW(1585) & ChrW(1583)
For i = 1 To 5
    If Sheets(3).Range("a1") = Sheets(1).Cells(i + 1, 2) Then
   
        For j = 1 To 4
            If Sheets(1).Cells(i + 1, j + 2) = d Then
            Sheets(3).Range("b" & 1000).End(3).Offset(1) = Sheets(1).Cells(1, j + 2)
            End If
        Next j
    End If
Next i
End Sub

[s.313]

سلام،
به ترتیب برای شیت دوم و سوم، نام درس یا شخص رو داخل سلول a1 وارد کرده سپس کد های زیر رو اجرا کنید :
شیت دوم :

Sub test()
lrow2 = Sheets(2).Range("b" & Rows.Count).End(3).Row
Sheets(2).Range("b2:b" & lrow2).ClearContents
Sheets(2).Range("b1") = ChrW(1606) & ChrW(1575) & ChrW(1605) & ChrW(32) & ChrW(1588) & ChrW(1582) & ChrW(1589)
d = ChrW(1583) & ChrW(1575) & ChrW(1585) & ChrW(1583)
For i = 1 To 4
    If Sheets(2).Range("a1") = Sheets(1).Cells(1, i + 2) Then
        For j = 1 To 5
            If Sheets(1).Cells(j + 1, i + 2) = d Then
            Sheets(2).Range("b" & 1000).End(3).Offset(1) = Sheets(1).Cells(j + 1, 2)
            End If
        Next j
    End If
Next i
End Sub

شیت سوم :

Sub test2()
lrow2 = Sheets(3).Range("b" & Rows.Count).End(3).Row
Sheets(3).Range("b2:b" & lrow2).ClearContents
Sheets(3).Range("b1") = ChrW(1606) & ChrW(1575) & ChrW(1605) & ChrW(32) & ChrW(1583) & ChrW(1585) & ChrW(1587)
d = ChrW(1583) & ChrW(1575) & ChrW(1585) & ChrW(1583)
For i = 1 To 5
    If Sheets(3).Range("a1") = Sheets(1).Cells(i + 1, 2) Then
   
        For j = 1 To 4
            If Sheets(1).Cells(i + 1, j + 2) = d Then
            Sheets(3).Range("b" & 1000).End(3).Offset(1) = Sheets(1).Cells(1, j + 2)
            End If
        Next j
    End If
Next i
End Sub

سلام. ممنون از لطفتون. واقعا عالی بود. یه فایل دیگه دارم که بر اساس کد پرسنلی برام مشخصات افراد رو سرچ و ثبت و ویرایش میکنه.
میخواستم ببینم میشه تغییر داد تا این سرچ و ثبت و ویرایش بر اساس نام افراد انجام بشه؟
فایل رو پیوست میکنم.ممنون میشم یه نگاه بهش بندازید..