استخلاص بيانات الموظفين المشتركين معا

[dada]

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

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

الموظفين المشتركين.xlsx

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

جرب هذا الماكرو

Option Explicit
Sub Farz()
Dim Sh As Worksheet
Dim col As New Collection
Dim arr(), x%, m%, ro%, i%, y%
Set Sh = Sheets("Sheet1")
ro = Sh.Cells(Rows.Count, 2).End(3).Row

With Sh
 .Range("F3").CurrentRegion.Clear
    For i = 2 To ro
          On Error Resume Next
      If .Cells(i, 4) <> vbNullString Then
        col.Add .Cells(i, 4).Value, CStr(.Cells(i, 4).Value)
      End If
    Next
          On Error GoTo 0
    m = 3: y = 7
    If col.Count Then
      For i = 1 To col.Count
        .Cells(m, y - 1) = col(i)
          For x = 2 To ro
          If .Cells(x, 4) = col(i) Then
             .Cells(m, y) = .Cells(x, 2)
             .Cells(m, y + 1) = .Cells(x, 3)
             y = y + 2
          End If
        Next
        m = m + 1: y = 7
      Next
    End If
End With
If Sh.Cells(3, "F") <> vbNullString Then
 With Sh.Range("F3").CurrentRegion
      .Borders.LineStyle = 1
      .InsertIndent 1
      .Font.Size = 14: .Font.Bold = True
      .Interior.ColorIndex = 40
      .Sort key1:=.Cells(1, 1), Header:=2
 End With
End If
Set col = Nothing
End Sub

الملف مرفق

 

Common_Employ.xlsm

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

و هذا ما يفعله الماكرو بالضبط

 

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

54 دقائق مضت, dada said:

فيظهر امام كل صف لقائد المجموعة اسماء و اكود الموظفين المكتوب  كود القائد امامه 

اليس هذا ما تريده

[dada]

استاذي الكريم في اهتمامك الصبور علي ، مثلا اول قائد لمجموعه احمد في الصف الاول المطلوب بداء من الخليهE2 يظهر اسماء و اكواد الفريق معه

فكل قائد يظهر في الصف الخاص به بجوار بياناته اسماء و اكواد فريقه بمجرد كتابة كود القائد امام عناصر الفريق.  شاكر لك مجهودك معي داعي الله يجزيك خيرا عني

الموظفين المشتركين.xlsx

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

منذ ساعه, dada said:

استاذي الكريم في اهتمامك الصبور علي ، مثلا اول قائد لمجموعه احمد في الصف الاول المطلوب بداء من الخليهE2 يظهر اسماء و اكواد الفريق معه

فكل قائد يظهر في الصف الخاص به بجوار بياناته اسماء و اكواد فريقه بمجرد كتابة كود القائد امام عناصر الفريق.  شاكر لك مجهودك معي داعي الله يجزيك خيرا عني

الموظفين المشتركين.xlsx 10.27 kB · 0 تنزيلات

كيف لي ان أحدد من هو القائد في العامود B كيف أعرف المزظفين التابعين له (هل يا ترى من خلال لون الخلية التي على يساره؟ ام ماذا؟)

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

ممكن ان يكون الماكرو المطلوب

Option Explicit
Sub Salim_Code()

Dim Sh As Worksheet
Dim Add1$, Add2$
Dim FRg As Range
Dim m%, ro%, i%, x%, y%

Set Sh = Sheets("Sheet1")
Sh.Range("G2:P100").Clear
ro = Sh.Cells(Rows.Count, 2).End(3).Row
m = 7
For i = 2 To ro
  Set FRg = Sh.Range("D1:D" & ro).Find(Sh.Cells(i, 1), lookat:=1)
     
   If Not FRg Is Nothing Then
    Add1 = FRg.Row: Add2 = Add1
     Do
        Cells(i, m) = Cells(Add2, 2)
        Cells(i, m + 1) = Cells(Add2, 3)
        Set FRg = Sh.Range("D1:D" & ro).FindNext(FRg)
        Add2 = FRg.Row
        m = m + 2
     Loop Until Add2 = Add1
   End If
   m = 7
 Next
 x = Sh.Cells(Rows.Count, "G").End(3).Row
  For i = 2 To x
   If Sh.Cells(i, "G") <> vbNullString Then
   y = Application.CountA(Sh.Cells(i, "G").Resize(, 10))
    With Sh.Cells(i, "G").Resize(, y)
      .Borders.LineStyle = 1
      .InsertIndent 1
      .Font.Size = 14: .Font.Bold = True
      .Interior.ColorIndex = 35
    End With
   End If
   Next
End Sub

الملف مرفق

 

My_Employ.xlsm

[Ali Mohamed Ali]

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

[dada]

جزاك الله عنا كل خير و نفعنا بك و زادك الله من فضله  الاخ و الاستاذ سليم حاصبيا