تحليل بيانات

[Ahmed93c]

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

عندي شيت اكسل في داتا

العمود الاول في داتا اسماء احمد ، محمد ، ياسر وهكذا ومكررين في العمود

العمود التاني فيه مواقع زي مثلا التجمع ، الشروق ، مدينة نصر كل اسم من العمود الاول قصاده موقع من العمود التاني

العمود التالت الاسماء بس مش مكررين

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

 

مرفق شيت توضيحي

 

وتفضلوا بقبول فائق الاحترام والتقدير

Book2.xlsx

[عبدالله بشير عبدالله]

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

الكود يقوم بفرز الاسماء المكررة ويضعها في العمود C 

Sub تجميع()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim dict As Object
    Dim name As Variant, location As String
    Dim outputRow As Long
    Set ws = ActiveSheet
Set dict = CreateObject("Scripting.Dictionary")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
    name = ws.Cells(i, 1).Value
    location = ws.Cells(i, 2).Value
    
    If name <> "" Then
        If dict.Exists(name) Then
            dict(name) = dict(name) & " / " & location
        Else
            dict(name) = location
        End If
    End If
Next i

ws.Range("C1:D" & ws.Rows.Count).ClearContents

outputRow = 1
For Each name In dict.Keys
    ws.Cells(outputRow, 3).Value = name
    ws.Cells(outputRow, 4).Value = dict(name)
    outputRow = outputRow + 1
Next name

End Sub

Book2.xlsb

[Ahmed93c]

20 دقائق مضت, عبدالله بشير عبدالله said:

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

الكود يقوم بفرز الاسماء المكررة ويضعها في العمود C 

Sub تجميع()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim dict As Object
    Dim name As Variant, location As String
    Dim outputRow As Long
    Set ws = ActiveSheet
Set dict = CreateObject("Scripting.Dictionary")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
    name = ws.Cells(i, 1).Value
    location = ws.Cells(i, 2).Value
    
    If name <> "" Then
        If dict.Exists(name) Then
            dict(name) = dict(name) & " / " & location
        Else
            dict(name) = location
        End If
    End If
Next i

ws.Range("C1:D" & ws.Rows.Count).ClearContents

outputRow = 1
For Each name In dict.Keys
    ws.Cells(outputRow, 3).Value = name
    ws.Cells(outputRow, 4).Value = dict(name)
    outputRow = outputRow + 1
Next name

End Sub

Book2.xlsb 16.86 kB · 1 download

شكرا جدا أ / عبد الله تسلم ايد حضرتك