Soru Instagram Kişi Etiketleme Analizi

[kurmayy]

Merhaba..

Ekteki dosyada yaptığımız bir çekiliş sonucunu çıkarmam gerekiyor. Yardımlarınız için şimdiden çok teşekkürler..

Etiketleyen kişinin etiketlediklerini o ismin karşısına sıralamak istiyorum..

pinarkeremert1805    @gamzem    @aysegull_ackln    @tarikbirnur    @ptanay    @duyguozturk26
@gamzem                 
pinarkeremert1805                 
@aysegull_ackln                 
pinarkeremert1805                 
@tarikbirnur                 
pinarkeremert1805                 
@ptanay                 
pinarkeremert1805                 
@duyguozturk26                 
nazooo107                 
@esra_kizilkaya_teke                 
nazooo107                 
@pnrhalac                 
nazooo107                 
@nihalkilic7740                 
nazooo107                 
@_busra_celik19                 
nazooo107

 

[Asri]

Aşağıdaki şekilde yapabilirsiniz.

Dosya ektedir.

Sub Listele()
    Sheets("Liste").Select
    Sheets("Sonuc").Cells.ClearContents
    Columns("A:A").Copy Sheets("Sonuc").Range("A1")
    
    Sheets("Sonuc").Select
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    For i = sonsatir To 1 Step -1
       veri = Cells(i, "A").Value
       Cells(i, "A").Value = Trim(veri)
       If Left(veri, 1) <> "@" Then
          Cells(i, "B").Value = Trim(ekle)
       Else
          ekle = veri
          Rows(i).Delete
       End If
    Next i
 
    sonsatir = Cells(Rows.Count, "A").End(3).Row
     For i = sonsatir To 1 Step -1
        yeniveri = Cells(i, "A").Value
        If eskiveri = yeniveri Then
           Cells(i, "B").Value = Cells(i, "B").Value & "," & Cells(i + 1, "B").Value
           Rows(i + 1).Delete
        Else
           eskiveri = yeniveri
        End If
        
     Next i
End Sub

 

[Ömer BARAN]

Merhaba.
Alternatif olsun.
Verileri kendi bulunduğu yerde (farklı sayfaya yazdırma istenirse birkaç satırlık kod ilavesiyle elbette mümkündür)
istenilen şekilde düzenlemek için aşağıdaki kodu kullanabilirsiniz.
Kod'u, alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılacak
VBA ekranında sağdaki boş alana yapıştırıp, çalıştırın.

Sub BIRLESTIR_BRN()
Range("B:IV").ClearContents: son = Cells(Rows.Count, 1).End(3).Row
For brn1 = 1 To son
    If WorksheetFunction.CountIf(Range("A1:A" & brn1), Cells(brn1, 1)) = 1 _
                                    And Left(Cells(brn1, 1), 1) <> "@" Then
        For brn2 = brn1 + 1 To son
            If Cells(brn2 - 1, 1) = Cells(brn1, 1) And Left(Cells(brn2, 1), 1) = "@" Then _
            Cells(brn1, Cells(brn1, Columns.Count).End(1).Column + 1) = Trim(Cells(brn2, 1))
        Next
    End If
Next
Range("B1:B" & son).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns.AutoFit: MsgBox "İşlem tamam.", vbInformation, "..:: Ömer BARAN ::.."
End Sub

 

[kurmayy]

Yardımlarınız için çok teşekkürler.. Çok işime yaradı son bir sorum daha olacak..

Örnek D2:SL2 aralığındaki tekrar eden verileri saydırmak istiyorum bunu nasıl yapabilirim???