Sütunda olan aynı isimlerin satır numarasını bulma

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,602
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
12-02-2029
Günaydın Arkadaşlar,
A5 ten itibaren A sütununda tekrarlayan isimler var, bu isimlerden E1 de olanın satır numaralarını G5 ten itibaren G sütununda sıra ile yazdırmak istiyorum. Bu işlemi fonksiyonla yapabiliyorum. makro ile yapmak istiyorum.
Saygılarımla
 

Ekli dosyalar

Son düzenleme:

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz, E1 değiştikçe listeleme yapar:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E1]) Is Nothing Then Exit Sub
son = WorksheetFunction.Max(Cells(Rows.Count, "A").End(3).Row, 5)
eski = WorksheetFunction.Max(Cells(Rows.Count, "G").End(3).Row, 5)
If Target = "" Then Exit Sub
If Selection.Count > 1 Then Exit Sub
Range("G5:G" & eski).ClearContents
For i = 5 To son
    If Cells(i, "A") = Target Then
        yeni = WorksheetFunction.Max(Cells(Rows.Count, "G").End(3).Row + 1, 5)
        Cells(yeni, "G") = i
    End If
Next
End Sub
 

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,602
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
12-02-2029
Sayın Yusuf44,
Çok teşekkür ederim, işimi gördü.
Bunu adı Ali olanlar için istemiş olsaydım nasıl bir değişiklik yapmalıyım. Yani Ali Sert, Ali Kuş, Mehmet Ali Kaçtı, ... gibi isimler olsaydı E1 'e Ali yazıldığında A sütununda hücrede ali yazılı olanları kastediyorum.
Saygılarımla
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodu deneyin:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E1]) Is Nothing Then Exit Sub
son = WorksheetFunction.Max(Cells(Rows.Count, "A").End(3).Row, 5)
eski = WorksheetFunction.Max(Cells(Rows.Count, "G").End(3).Row, 5)
If Target = "" Then Exit Sub
If Selection.Count > 1 Then Exit Sub
Range("G5:G" & eski).ClearContents
For i = 5 To son
    If Replace(WorksheetFunction.Proper(Cells(i, "A")), WorksheetFunction.Proper(Target), "") <> WorksheetFunction.Proper(Cells(i, "A")) Then
        yeni = WorksheetFunction.Max(Cells(Rows.Count, "G").End(3).Row + 1, 5)
        Cells(yeni, "G") = i
    End If
    
Next
End Sub
 

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,602
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
12-02-2029
İlginize çok teşekkür ederim arkadaşım.
Saygılarımla
 
Üst