اخفاء اعمدة المواد الدراسية دون المادة المختارة مع الارقام السرية والمجموعات

[HANY SAAD]

السادة الاساتذة والزملاء كل عام وانتم بخير 

ارجو من حضراتكم مساعدتى فى هذا الملف 

الملف صفحة رصد درجات امتحان تحريرى 

اريد هنا عند اختيار المادة من الخلية N1  يتم اخفاء اعمدة باقى المواد مع اخفاء عمود الاسم ورقم الجلوس بحيث يتبقى عمود المادة المختارة مع عمود الرقم السرى وعمود رقم المجموعة والمسلسل فقط مع امكانية اظهار جميع الاعمدة اذا طلب ذلك 

صفحة الرصد.xlsx

[HANY SAAD]

للرفع

[محمد هشام.]

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

في 23‏/3‏/2024 at 22:38, HANY SAAD said:

اريد هنا عند اختيار المادة من الخلية N1  يتم اخفاء اعمدة باقى المواد

اظن انه يجب عليك اولا تغيير مكان خلية اختيار اسم المادة (N1) خارج نطاق البحث لانه في حالة تم اخفاء عمود مادة الدين مثلا عمود (N) سيتم اخفاء خلية الاختيار  

لنفترض ان الخلية المحددة هي (R1)

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("R1")) Is Nothing Then

  Dim x As Range, rng As Range
  Set x = Clé([R1], [G7:P7]): Set rng = Columns("E:F")
  
  Application.ScreenUpdating = False
  If x Is Nothing Then MsgBox "مادة" & "  " & [R1] & " : " & " غير موجودة ", vbExclamation: Exit Sub
    Columns("C:P").EntireColumn.Hidden = True
    x.EntireColumn.Hidden = False: rng.EntireColumn.Hidden = False
    ActiveWindow.ScrollColumn = 1
    End If
End Sub
Function Clé(a, b As Range) As Range
  Dim i&
  On Error Resume Next
  i = WorksheetFunction.Match(a, b, 0)
  If i Then Set Clé = b(i)
End Function

اظهار الاعمدة

Sub Show_all_columns()
   Sheets("Sheet1").Columns("C:P").EntireColumn.Hidden = False
End Sub

 

 بطريقة اخرى 

Sub Hide_columns()

    Dim Clé As Variant, desWS As Worksheet, rng As Range
    Set desWS = ThisWorkbook.Sheets("Sheet1"): Clé = [R1].Value
    
 If Clé > 0 Then
    With desWS
    Set rng = .Rows(7).Find(Clé, LookIn:=xlValues, lookat:=xlWhole)
        If Not rng Is Nothing Then
        Application.ScreenUpdating = False
           .Columns("C:P").EntireColumn.Hidden = True
            rng.EntireColumn.Hidden = False
           .Columns("E:F").EntireColumn.Hidden = False
  Else
  MsgBox "مادة" & "  " & Clé & " : " & " غير موجودة ", vbExclamation: Exit Sub

            End If
        End With
      End If
      
    ActiveWindow.ScrollColumn = 1
    Application.ScreenUpdating = True
End Sub

 

صفحة الرصد V2.xlsm

[HANY SAAD]

أولا لم أجد من الكلمات ما يوفيك حقك استاذى محمد هشام. 

ولكن اقول جعلك الله عونا لكل من يريد العون وجعله فى ميزان حسناتك 

لو كان بالامكان ترتيب الرقم السرى بمعنى الترتيب بدأ من الاسفل مثلا هل من الممكن ترتيب الارقام السرية