Sayfa daki Kişileri Tek Sayfa ya Getirme ???

Katılım
26 Aralık 2004
Mesajlar
351
Excel Vers. ve Dili
Excel 2007 Türkçe
Merhaba;

Ekte Göndermiş olduğum Çalışma Kitabındaki, Sayfalardan yani (G) Sütununda Bulunan Ayları olan kişileri (YAZDIR) Sayfasına Toplamak. Eğer (G) Sütunda O Ay yoksa O Kişi (YAZDIR) Sayfasında da olmayacak Lakin Diğerleri Bu Sayfada Toplu Olarak Gelmesini Nasıl Sağlarız.

Saygılarımla.
 

Ekli dosyalar

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.

Konuyu FONKSİYONLAR bölümüne açmışsınız ancak makro kullanılarak çözüm önermek kolayıma geldi.

Veri yığınının çok büyük olmayacağını düşünerek For...Next döngüsü kullanarak (yani satır satır işlem yapılması)
çözüm önerisinde bulunmak istedim.

Veri yığınınız büyükse For...Next döngüsü yerine FİLTRE yöntemiyle daha hızlı sonuca ulaşılabilmesi lazım.
.
Kod:
[FONT="Arial Narrow"][B]Sub AY_YAZDIR()[/B]
Set y = Sheets("YAZDIR")
If y.[A65536].End(3).Row > 1 Then y.Range("A2:G" & y.[A65536].End(3).Row).ClearContents
ay = LCase(Format(CDate("01/" & Month(Date) & "/" & Year(Date)), "mmmm"))
For s = 1 To Sheets.Count
If Sheets(s).Name <> "YAZDIR" Then
    For ssat = 2 To Sheets(s).[G65536].End(3).Row
        If LCase(Sheets(s).Cells(ssat, "G")) = ay Then
            ysat = y.[A65536].End(3).Row + 1: y.Cells(ysat, 1) = ysat - 1
[COLOR="Blue"]            y.Cells(ysat, 2) = Sheets(s).Cells(ssat, 2)
            y.Cells(ysat, 3) = Sheets(s).Cells(ssat, 3)
            y.Cells(ysat, 4) = Sheets(s).Cells(ssat, 4)
            y.Cells(ysat, 5) = Sheets(s).Cells(ssat, 7)[/COLOR]
[COLOR="Red"]            For ysut = 2 To 7
                y.Cells(ysat, ysut) = Sheets(s).Cells(ssat, ysut)
            Next: [/COLOR]End If: Next: End If: Next: MsgBox "İşlem Tamamlandı..."
[B]End Sub[/B][/FONT]
 

programer

Altın Üye
Katılım
26 Mayıs 2005
Mesajlar
607
Excel Vers. ve Dili
Office 2022 - Türkçe
Altın Üyelik Bitiş Tarihi
16-03-2025
Sayın Ömer BARAN cevap vermiş. Bende yaptığım dosyayı ekledim. İyi çalışmalar.
 

Ekli dosyalar

Katılım
26 Aralık 2004
Mesajlar
351
Excel Vers. ve Dili
Excel 2007 Türkçe
Ömer Bey ilgilerinize Teşekkürler Ederim.
Lakin Yazdır Sayfasında Bazı Değişiklik Yaptım Ona Göre Uyarlayabilirmiyiz. Yani (Sıra No) (T.C. No) (Adı Soyadı) (Ünvanı) (Çalıştığı Ay) dan oluşan şekilde olur mu?
 

Ekli dosyalar

Katılım
26 Aralık 2004
Mesajlar
351
Excel Vers. ve Dili
Excel 2007 Türkçe
Yalnız Dikkatimi Çeken Bir Problem Var Herhalde. Şubat Yada diğer Aylar Yazıldığında Onlar Gelmiyor.

Oraya Kimler Hangi Ayda ise Yani (Ocak-Şubat-Mart) Gibi Yazdığımda O Sutuna Boş olan lar Hariç Gelmesi Gerekir.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Tekrar merhaba.

Açılış mesajınızdaki; "...... Bulunan Ayları....(G) Sütunda O Ay yoksa...."
şeklindeki cümleyi İÇİNDE BULUNULAN AY olarak anlamıştım.
İçinde bulunulan ay kriterine göre; önceki cevabımı güncelledim.
Kırmızı olanları silip, mavi olanları ekleyerek o kod kullanılabilir.

İLAVE:
Anlıyorum ki; G sütunu DOLU OLANLAR şeklinde istiyorsunuz.
Bunun için aşağıdaki kod'u kullanabilirsiniz.
.
Kod:
[FONT="Arial Narrow"][B]Sub AY_DOLU_OLANLARI_YAZDIR()[/B]
Set y = Sheets("YAZDIR")
If y.[A65536].End(3).Row > 1 Then _
y.Range("A2:G" & y.[A65536].End(3).Row).ClearContents
    For s = 1 To Sheets.Count
        If Sheets(s).Name <> "YAZDIR" Then
            For ssat = 2 To Sheets(s).[G65536].End(3).Row
                If Sheets(s).Cells(ssat, "G") <> "" Then
                    ysat = y.[A65536].End(3).Row + 1
                    y.Cells(ysat, 1) = ysat - 1
                    y.Cells(ysat, 2) = Sheets(s).Cells(ssat, 2)
                    y.Cells(ysat, 3) = Sheets(s).Cells(ssat, 3)
                    y.Cells(ysat, 4) = Sheets(s).Cells(ssat, 4)
                    y.Cells(ysat, 5) = Sheets(s).Cells(ssat, 7)
                End If
            Next
        End If
    Next
MsgBox "İşlem Tamamlandı..."
[B]End Sub[/B][/FONT]
 
Katılım
26 Aralık 2004
Mesajlar
351
Excel Vers. ve Dili
Excel 2007 Türkçe
Teşekkürler Ederim. Ellerinize ve Emeğinize Sağlık
 
Üst