aldığım hediyeleri analiz etmek istiyorum

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
337
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
Zaman içinde birçok arkadaşımdan gelen hediyeleri listedim. Şimdi o listeden hangi hediyeden kaç tane var? kim? ne zaman? ne vermiş? sorularına cevap arıyorum. Listeyi benim yaptığım formattan istediğim formata çevirecek makroya ihtiyacım var.

ekteki belgede ayrıntılı açıklama yazdım.
Yardımcı olacak arkadaşlara şimdiden başarılar ve teşekkürler.
 

Ekli dosyalar

Katılım
7 Haziran 2010
Mesajlar
227
Excel Vers. ve Dili
2007 Türkçe
özet tablo kullanın her türlü şekilde liste alabilirsiniz
 

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
337
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
malesef bu bilgi bana yardımcı olmadı. Başka fikri olan arkadaşları bekliyorum. teşekkürler
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
Merhaba

Bu kodu deneyiniz.
Kod:
Sub HediyeList()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
text1 = "Arkadaşın Adı"
text2 = "Verdiği Yıl"
text3 = "Yakınlık Derecesi"
text4 = "Verdiği Hediyeler"
x = 1
For i = 2 To s1.Range("a65536").End(3).Row
s2.Cells(x, 1) = text1
s2.Cells(x, 2) = s1.Cells(i, 1)
s2.Cells(x + 1, 1) = text2
s2.Cells(x + 1, 2) = s1.Cells(i, 2)
s2.Cells(x + 2, 1) = text3
s2.Cells(x + 2, 2) = s1.Cells(i, 3)
s2.Cells(x + 3, 1) = text4
s2.Cells(x + 3, 2) = s1.Cells(i, 4)
x = x + 5
Next
Call List
End Sub
Kod:
Sub List()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa3")
s2.Cells(1, 1) = "Hediye Adı"
s2.Cells(1, 2) = "Sayısı"
s2.Cells(1, 3) = "İlk Ne Zaman Verilmiş"
s2.Cells(1, 4) = "İlk Kim Vermiş"
  y = 2
For x = 2 To s1.[a65536].End(3).Row
    a = Split(";@" & s1.Cells(x, 4), ";@")
    For i = 1 To UBound(a)
        s2.Cells(y, 1) = Left(a(i), Len(a(i)))
        s2.Cells(y, 3) = s1.Cells(x, 2)
        s2.Cells(y, 4) = s1.Cells(x, 1)
        y = y + 1
Next
Next
Call MükerrerSil
End Sub
Kod:
Sub MükerrerSil()
Set s2 = Sheets("Sayfa3")
ssat = s2.Range("a65536").End(3).Row
For i = 2 To ssat
s2.Cells(i, 2) = Application.WorksheetFunction.CountIf(s2.Range("a2:a" & ssat), s2.Cells(i, 1))
Next
For j = ssat To 2 Step -1
If Application.WorksheetFunction.CountIf(s2.Range("a2:a" & ssat), s2.Cells(j, 1)) > 1 Then
s2.Cells(j, 2).EntireRow.Delete
End If
Next
End Sub
 

Ekli dosyalar

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
337
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
teşekkür ederim, ancak bazı hatalar veriyor şöyle ki
Hediye Sayısı sütünu boş, yani hediyeleri saymıyor
Bir de ben listeyi yaparken hediyeler arasına ;@ koymuştum, makro sonucu çıkacak listede hediyeler arasında , olması gerekiyor. Gerçi bu sorun daha sora bul-değiştir ile yapılabilir ama bir makronun içinde olsa daha iyi olacak. çok teşekkürler
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
teşekkür ederim, ancak bazı hatalar veriyor şöyle ki
Hediye Sayısı sütünu boş, yani hediyeleri saymıyor
Bir de ben listeyi yaparken hediyeler arasına ;@ koymuştum, makro sonucu çıkacak listede hediyeler arasında , olması gerekiyor. Gerçi bu sorun daha sora bul-değiştir ile yapılabilir ama bir makronun içinde olsa daha iyi olacak. çok teşekkürler
Kodu revize edip dosyayı ekledim, kontrol ediniz.
 

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
337
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
kontrol ettim arkadaşım çok teşekkürler. Bu haliyle işimi görür.
Mükerrer makrosu işime yaramaz, mükerrer olabilir (aynı hediyeyi başkaları da verebilir)sorun değil. Ama aynı satırdaki mükerrer hediyeleri silecek bir makro yaparsan bonus olur benim için.
Asıl istediğim sütun sayısını arttırmak istersem nasıl olacak? 10-15 sütuna kadar çıkmak istediğimde nasıl yapacağımı öğretirsen - ya da 10 sütunluk bir makro hazırlarsan- çok sevinirim. Anladığım kadarıyla makro içinde sütun isimleri değiştirmek kolay.

İyi bayramlar
İyi bayramlar.
 

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
337
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
Arkadaşım biraz kurcalayınca hediyelrim makrosuna sütun ekleme-çıkarma değiştirme işlerini yapabildim. Şu an "hediyelerim" makrosu tam istediğim gibi.
List makrosunda hediyeler 4. sütunda idi. Şimdi 9. sütuna geçti. nereyi değiştirmem gerekecek, onu bi yazarsan sanırım bu iş bitecek. Seni de çok yordum kusura kalma, hakkını helal et.
 
Üst