إدراج الاسماء

[muneef]

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

كل الشكر لكم أخواني الأفاضل على مجهوداتكم الطيبة

وأرجو منكم  التكرم بمساعدتنا في إيجاد حل في الملف المرفق

شاكرين لكم حسن تعاونكم

إدراج الاسماء تلقائي.xlsx

[سليم حاصبيا]

جرب هذا الكود

Option Explicit

Sub get_Prof_names()
  Dim sh As Worksheet, Rg As Range
  Dim i%, Yer%
  Dim Salim As Object
  
  Set Salim = CreateObject("Scripting.Dictionary")
  Set sh = Sheets("sheet1")
  Set Rg = sh.Range("G3").CurrentRegion
 
 If Rg.Rows.Count > 1 Then _
    Rg.Offset(1).Resize(Rg.Rows.Count - 1).Clear
 
 Yer = sh.Range("G1"): i = 2
 
 Do Until sh.Cells(i, 1) = vbNullString
      If Year(Cells(i, 2)) = Yer Then
        Salim(Cells(i, 1).Value) = vbNullString
      End If
  i = i + 1
 Loop
 If Salim.Count Then
    With sh.Range("G4").Resize(Salim.Count)
      .Value = Application.Transpose(Salim.Keys)
      .Borders.LineStyle = 1
      .Font.Bold = True: .Font.Size = 16
      .InsertIndent 1: .Interior.ColorIndex = 35
    End With
 End If
End Sub

الملف مرفق

 

Prof_names.xlsm

[الرائد77]

بعد اذن حبيبي سليم

معادلة صفيف. أكتب فقط  السنة في الخلية g1

=IFERROR(INDEX($A$2:$A$170; MATCH(0;COUNTIF($G$3:G3; IF(($G$1=YEAR($B$2:$B$170)); $A$2:$A$170; $G$3)); 0)); "")

 

إدراج الاسماء تلقائي.xlsx

[سليم حاصبيا]

ممتازة منك صديقي رائد (لكنها تدرج المكرر في حال وجوده)

هذه معادلة احرى (بردو تدرج المكرر في حال وجوده)

(سبق وان قلت ان استعمال الدالة  IFERROR ) يفضل عدم استعمالها

=IF(ROWS($A$1:A1)>SUMPRODUCT(--(YEAR($B$2:$B$50)=$G$1)),"",INDEX($A$2:$A$50,SMALL(IF($A$2:$A$50<>"",IF(YEAR($B$2:$B$50)=$G$1,ROW($A$2:$A$50)-ROW($A$2)+1)),ROWS($A$1:A1))))

اذا لم نتعمل معك استبدل الفاصلة "," بفاصلة منقوطة ";" مع (Ctrl+Shift+Enter)

Prof_names.xlsm

 

 

[سليم حاصبيا]

تفضل    لكن في مشاركة مستقلة

[الرائد77]

أخي سليم . المعادلة لا تدرج المكرر . النتيجة بالصورة

 

[سليم حاصبيا]

منذ ساعه, الرائد77 said:

أخي سليم . المعادلة لا تدرج المكرر . النتيجة بالصورة

 

معك كل الحق

أعتذر انا صراحة لم أجربها