Her ismi bir defa getirme

[serkan.sevinc]

Merhaba.
ÖZET sayfası A3 hücresinden A1000 hücresine kadar farklı personel isimşeri bulunuyor
ÖZET sayfası B4 hücresinden B1000 hücresine kadar depo isimleri bulunuyor
YARIŞMA sayfasında C8 hücresinde istenen depo adı bulunuyor
YARIŞMA sayfası C10 hücresine ve aşağıya doğru ÖZET sayfasındaki depo isimlerine göre personel isimlerini tekrarsız şekilde getirmesini istiyorum.
Aşağıdaki şekilde bir formül uyguladım ama sadece 1 isim getiriyor. Yardımcı olabilir misiniz?

=EĞERHATA(İNDİS(Özet!$A$3:$A$10000;KÜÇÜK(EĞER((Özet!$B$3:$B$10000=$C$8)*(Özet!$C$3:$C$10000=1);SATIR(Özet!$A$3:$A$10000)-SATIR(Özet!$A$3)+1);SATIR(A1)));"")

 

[muhasebeciyiz]

{=EĞERHATA(İNDİS(ÖZET!$A$3:$A$1000; KÜÇÜK(EĞER(ÖZET!$B$3:$B$1000=$C$8; SATIR(ÖZET!$A$3:$A$1000)-2); SATIR(A1))); "")}

Eğer bu sayfaların adları farklıysa, formüldeki ÖZET! ve YARIŞMA! kısımlarını kendi sayfa adlarınızla değiştirmeniz gerekir.Dizi formülüdür.

 

[serkan.sevinc]

maalesef olmadı. Hem 1 satır geldi, hemde gelen isim yanlış oldu

 

[antonio]

Merhaba,
Veri sekmesi altındaki "Yinelenenleri kaldır" aracını kullanmanızı öneririm.

 

[airborne]

s.a.

Sub DepoyaGorePersonelListele()
    Dim wsOzet As Worksheet, wsYarisma As Worksheet
    Dim depoAdi As String
    Dim sonSatir As Long, i As Long
    Dim personel As String
    Dim dict As Object
    Dim hedefSatir As Long
   
    ' Sayfaları tanımla
    Set wsOzet = ThisWorkbook.Sheets("ÖZET")
    Set wsYarisma = ThisWorkbook.Sheets("YARIŞMA")
   
    ' YARIŞMA sayfasındaki depo adı
    depoAdi = wsYarisma.Range("C8").Value
   
    ' ÖZET sayfasında son satırı bul
    sonSatir = wsOzet.Cells(wsOzet.Rows.Count, "A").End(xlUp).Row
   
    ' Tekrarsız liste için Scripting.Dictionary kullan
    Set dict = CreateObject("Scripting.Dictionary")
   
    ' ÖZET sayfasında dolaş
    For i = 3 To sonSatir
        If wsOzet.Cells(i, "B").Value = depoAdi Then
            personel = wsOzet.Cells(i, "A").Value
            If Not dict.exists(personel) Then
                dict.Add personel, 1
            End If
        End If
    Next i
   
    ' YARIŞMA sayfasında C10'dan itibaren yaz
    wsYarisma.Range("C10:C1000").ClearContents
    hedefSatir = 10
    For Each personel In dict.keys
        wsYarisma.Cells(hedefSatir, "C").Value = personel
        hedefSatir = hedefSatir + 1
    Next personel
   
    MsgBox "Listeleme tamamlandı!", vbInformation
End Sub

Dener misiniz

 

[serkan.sevinc]

teşekkürler