birden fazla sayfada düşeyara ile veri aratıp sonuçları toplama hakkında yardım

C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Öncelikle şunu belirtmeliyim ki ben yapmak istediğim şey için düşeyara dan yola çıktığım için konu başılığını böyle açtım. Forumda aradığımda da sorunuma çözüm bulamadım. Belki de benim yapmam gereken şeyin çözümü bambaşkadır. Bu nedenle gelen cevaplara göre başka arkadaşların da yararlanması için başlığı daha doğru şekilde düzenleyebiliriz sanırım. Yaklaşık 30 sayfadan oluşan bir dosyam var.Dosyada son sayfada bulunan listedeki verilerden bazıları iç sayfalarda geçiyor. Bunların yanında da farklı veriler var. Ben bu listedeki verilerin diğer sayfalarda geçtiği yerlerde yanında yazan verilerin kaç kez tekrar ettiğini ayrı ayrı toplamak istiyorum. Açıklama epey karmaşık oldu farkındayım. O yüzden dosya ekliyorum, sanırım orada biraz daha detaylı anlaşılır durumda. Düşeyara,eğer bu formülleri farklı şekillerde kullanıp çözüme gitmeye çalıştım ama başaramadım. Bu nedenle en sade haliyle dosyayı ekledim. Forumun üstadlarından destek bekliyorum :)

http://www.dosya.tc/server12/6qq2se/ETUT_TOPLAMA.xlsx.html
 
Ö

Ö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.

VARSAYIMLAR:
-- Sayfalar, örnek belgedeki gibi; Sayfa1, Sayfa2, Sayfa3..... gibi adlandırılacaktır.
-- Sayfa31 1'inci satırında, diğer sayfalarda kullanılan ders adları eksiksiz (sırası önemli değil) ve
diğer sayfaların C sütunlarındaki ders adları ile birebir aynı olacak şekilde yazılacaktır.

Yukarıdaki varsayımlara göre;
-- Alt taraftan Sayfa31'in adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
-- Açılacak VBA ekranında, sağdaki BOŞ alana aşağıdaki kod'u yapıştırın,
-- Sayfa31'e bir adet Metin Kutusu/Şekil/Düğme ekleyin,
-- Eklediğiniz Metin Kutusu/Şekil/Düğme'ye fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılacak küçük ekranda LISTELE makrosunun adını fareyle tıklayıp işlemi onaylayın.

Artık sayfaya eklediğiniz bu nesneye tıkladığınızda istenilen işlem gerçekleşecektir.
.
Kod: 
[B][COLOR="Blue"]Sub LISTELE()[/COLOR][/B]
Set s = Sheets("Sayfa31")
ssonsat = s.Cells(Rows.Count, 1).End(3).Row
ssonsut = s.Cells(1, Columns.Count).End(1).Column
s.Range(s.Cells(2, 2), s.Cells(ssonsat, ssonsut)).ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To ssonsat 
    For sh = 1 To ThisWorkbook.Sheets.Count
        If Sheets(sh).Name <> "Sayfa31" Then
            Set varmi = Sheets(sh).[B:B].Find(s.Cells(sat, 1), LookAt:=xlWhole)
            If Not varmi Is Nothing Then
                If Sheets(sh).Cells(varmi.Row, 3) <> "" Then ders = Sheets(sh).Cells(varmi.Row, 3)
                If WorksheetFunction.CountIf(s.[1:1], ders) > 0 Then
                    sut = WorksheetFunction.Match(ders, s.[1:1], 0)
                    s.Cells(sat, sut) = s.Cells(sat, sut) + 1
                End If: End If: End If
Next: Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "..:: Ömer BARAN ::.."
[B][COLOR="blue"]End Sub[/COLOR][/B]
 
muygun

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,207
Excel Vers. ve Dili
Excel-2003 Türkçe
Merhaba;
Ömer bey sorunu çözmüş.
Hazırladığım ek alternatif olsun.
İnceleyin.
İyi çalışmalar.
 

Ekli dosyalar

C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Ömer BARAN' Alıntı:
Merhaba.

VARSAYIMLAR:
-- Sayfalar, örnek belgedeki gibi; Sayfa1, Sayfa2, Sayfa3..... gibi adlandırılacaktır.
-- Sayfa31 1'inci satırında, diğer sayfalarda kullanılan ders adları eksiksiz (sırası önemli değil) ve
diğer sayfaların C sütunlarındaki ders adları ile birebir aynı olacak şekilde yazılacaktır.

Yukarıdaki varsayımlara göre;
-- Alt taraftan Sayfa31'in adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
-- Açılacak VBA ekranında, sağdaki BOŞ alana aşağıdaki kod'u yapıştırın,
-- Sayfa31'e bir adet Metin Kutusu/Şekil/Düğme ekleyin,
-- Eklediğiniz Metin Kutusu/Şekil/Düğme'ye fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılacak küçük ekranda LISTELE makrosunun adını fareyle tıklayıp işlemi onaylayın.

Artık sayfaya eklediğiniz bu nesneye tıkladığınızda istenilen işlem gerçekleşecektir.
.
Kod: 
[B][COLOR="Blue"]Sub LISTELE()[/COLOR][/B]
Set s = Sheets("Sayfa31")
ssonsat = s.Cells(Rows.Count, 1).End(3).Row
ssonsut = s.Cells(1, Columns.Count).End(1).Column
s.Range(s.Cells(2, 2), s.Cells(ssonsat, ssonsut)).ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To ssonsat 
    For sh = 1 To ThisWorkbook.Sheets.Count
        If Sheets(sh).Name <> "Sayfa31" Then
            gun = Replace(Sheets(sh).Name, "Sayfa", "")
            Set varmi = Sheets(sh).[B:B].Find(s.Cells(sat, 1), LookAt:=xlWhole)
            If Not varmi Is Nothing Then
                If Sheets(sh).Cells(varmi.Row, 3) <> "" Then ders = Sheets(sh).Cells(varmi.Row, 3)
                If WorksheetFunction.CountIf(s.[1:1], ders) > 0 Then
                    s.Cells(sat, WorksheetFunction.Match(ders, s.[1:1], 0)) = gun
                End If: End If: End If
Next: Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "..:: Ömer BARAN ::.."
[B][COLOR="blue"]End Sub[/COLOR][/B]
Genişletmek için tıkla ...
Öncelikle emeğiniz ve yanıtınız için teşekkürler. Dosyayı sanırım ancak gece inceleyecegim.su an telefondan okuyorum mesajları. Durumla ilgili sizi bilgilendirecegim.
 
C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
muygun' Alıntı:
Merhaba;
Ömer bey sorunu çözmüş.
Hazırladığım ek alternatif olsun.
İnceleyin.
İyi çalışmalar.
Genişletmek için tıkla ...
Ustad teşekkür ederim, dosyayı gece inceleyebileceğim ama yine harika bi iş çıkardığınızdan kuşkum yok ????
 
C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Ömer BARAN' Alıntı:
Merhaba.

VARSAYIMLAR:
-- Sayfalar, örnek belgedeki gibi; Sayfa1, Sayfa2, Sayfa3..... gibi adlandırılacaktır.
-- Sayfa31 1'inci satırında, diğer sayfalarda kullanılan ders adları eksiksiz (sırası önemli değil) ve
diğer sayfaların C sütunlarındaki ders adları ile birebir aynı olacak şekilde yazılacaktır.

Yukarıdaki varsayımlara göre;
-- Alt taraftan Sayfa31'in adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
-- Açılacak VBA ekranında, sağdaki BOŞ alana aşağıdaki kod'u yapıştırın,
-- Sayfa31'e bir adet Metin Kutusu/Şekil/Düğme ekleyin,
-- Eklediğiniz Metin Kutusu/Şekil/Düğme'ye fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılacak küçük ekranda LISTELE makrosunun adını fareyle tıklayıp işlemi onaylayın.

Artık sayfaya eklediğiniz bu nesneye tıkladığınızda istenilen işlem gerçekleşecektir.
.
Kod: 
[B][COLOR="Blue"]Sub LISTELE()[/COLOR][/B]
Set s = Sheets("Sayfa31")
ssonsat = s.Cells(Rows.Count, 1).End(3).Row
ssonsut = s.Cells(1, Columns.Count).End(1).Column
s.Range(s.Cells(2, 2), s.Cells(ssonsat, ssonsut)).ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To ssonsat 
    For sh = 1 To ThisWorkbook.Sheets.Count
        If Sheets(sh).Name <> "Sayfa31" Then
            gun = Replace(Sheets(sh).Name, "Sayfa", "")
            Set varmi = Sheets(sh).[B:B].Find(s.Cells(sat, 1), LookAt:=xlWhole)
            If Not varmi Is Nothing Then
                If Sheets(sh).Cells(varmi.Row, 3) <> "" Then ders = Sheets(sh).Cells(varmi.Row, 3)
                If WorksheetFunction.CountIf(s.[1:1], ders) > 0 Then
                    s.Cells(sat, WorksheetFunction.Match(ders, s.[1:1], 0)) = gun
                End If: End If: End If
Next: Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "..:: Ömer BARAN ::.."
[B][COLOR="blue"]End Sub[/COLOR][/B]
Genişletmek için tıkla ...
üstadım öncelikle tekrar tekrar ellerine sağlık. Ancak şöyle bir durum var ki makro hesap yapıyor ama fazla sayıyor. Yani mesela ben sadece bir sayfada bir öğrenci için bir tane din dersi seçtim diyelim hesapla dediğimde 3 hesaplıyor. Oysa sadece 1 bulması gerekiyor. dosyayı ekledim. Acaba sizin istediğinizden farklı bir şey mi yaptım ben ?
 

Ekli dosyalar

C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
muygun' Alıntı:
Merhaba;
Ömer bey sorunu çözmüş.
Hazırladığım ek alternatif olsun.
İnceleyin.
İyi çalışmalar.
Genişletmek için tıkla ...
hocam yine döktürmüşsünüz :) sorunsuz çalışıyor dosya. Elleriniz dert görmesin. Ben şimdi dosyada bazı değişiklikler yapacağım. Zannederim sayfa isimleri ile oynamamam gerekiyor makronun bozulmaması için. tekrar teşekkürler.
 
Ö

Ö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.
Kod'da küçük bir değişiklik yaptım.
Sayfayı yenileyerek önceki cevabımdaki kod'u tekrar kopyalayıp dener misiniz?
Sayfa isimlerinin düzenine ilişkin uyarının önemi kalmamış oluyor, sadece ders adlarının birebir aynı olması yeterlidir.

Önceki cevabımda sayfa adındaki sayı kısmının yazılacağını düşünmüştüm, siz sadece sayma istiyormuşsunuz.
.
 
C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Ömer BARAN' Alıntı:
Kod'da küçük bir değişiklik yaptım.
Sayfayı yenileyerek önceki cevabımdaki kod'u tekrar kopyalayıp dener misiniz?
Sayfa isimlerinin düzenine ilişkin uyarının önemi kalmamış oluyor, sadece ders adlarının birebir aynı olması yeterlidir.

Önceki cevabımda sayfa adındaki sayı kısmının yazılacağını düşünmüştüm, siz sadece sayma istiyormuşsunuz.
.
Genişletmek için tıkla ...
üstad elinize sağlık. Şimdi dediğiniz gibi çalışıyor. Gayet güzel ve sorunsuz. Çok teşekkürler
 
C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
muygun' Alıntı:
Merhaba;
Ömer bey sorunu çözmüş.
Hazırladığım ek alternatif olsun.
İnceleyin.
İyi çalışmalar.
Genişletmek için tıkla ...
üstad sana bir kez daha danışmak durumunda kaldım. şöyle ki c sütununda hangi dersler yazıyorsa öğrenciye göre bunları rapor sayfasında yazıyoruz. Ancak bir ilave durum geliştir o da şu ki eğer o dersten birden fazla vermemiz gerekirse o zaman ayın öğrenciyi bir daha bir daha mı yazacağız ? Ekte dosyayı incelerseniz orda daha detaylı ve açık bir şekilde durumu izah ettim.
 

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.
Tekrar merhaba.

Son örnek belgenize göre, kişi bazında ders saat toplamları için aşağıdaki kod'u kullanabilirsiniz.
.
Kod: 
[B][COLOR="blue"]Sub RAPORLA()[/COLOR][/B]
Set r = Sheets("rapor")
rsonsat = r.Cells(Rows.Count, 4).End(3).Row
rsonsut = r.Cells(1, Columns.Count).End(1).Column
r.Range(r.Cells(2, 5), r.Cells(rsonsat, rsonsut)).ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To rsonsat
    For sh = 1 To ThisWorkbook.Sheets.Count
        If Sheets(sh).Name <> "rapor" And Sheets(sh).Name <> "öğretmen" Then
            Set varmi = Sheets(sh).[B:B].Find(r.Cells(sat, 4), LookAt:=xlWhole)
            If Not varmi Is Nothing Then
                If Sheets(sh).Cells(varmi.Row, 6) > 0 Then
                    ders = Sheets(sh).Cells(varmi.Row, 3)
                    saat = Sheets(sh).Cells(varmi.Row, 6)
                End If
                If WorksheetFunction.CountIf(r.[1:1], ders) > 0 Then
                    sut = WorksheetFunction.Match(ders, r.[1:1], 0)
                    r.Cells(sat, sut) = r.Cells(sat, sut) + saat
                End If: End If: End If
Next: Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "..:: Ömer BARAN ::.."
[B][COLOR="Blue"]End Sub[/COLOR][/B]
 
muygun

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,207
Excel Vers. ve Dili
Excel-2003 Türkçe
cem116' Alıntı:
üstad sana bir kez daha danışmak durumunda kaldım. şöyle ki c sütununda hangi dersler yazıyorsa öğrenciye göre bunları rapor sayfasında yazıyoruz. Ancak bir ilave durum geliştir o da şu ki eğer o dersten birden fazla vermemiz gerekirse o zaman ayın öğrenciyi bir daha bir daha mı yazacağız ? Ekte dosyayı incelerseniz orda daha detaylı ve açık bir şekilde durumu izah ettim.
Genişletmek için tıkla ...
Merhaba;
Doğru anladıysam eki deneyin.
İyi çalışmalar.
 

Ekli dosyalar

C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Ömer BARAN' Alıntı:
Tekrar merhaba.

Son örnek belgenize göre, kişi bazında ders saat toplamları için aşağıdaki kod'u kullanabilirsiniz.
.
Kod: 
[B][COLOR="blue"]Sub RAPORLA()[/COLOR][/B]
Set r = Sheets("rapor")
rsonsat = r.Cells(Rows.Count, 4).End(3).Row
rsonsut = r.Cells(1, Columns.Count).End(1).Column
r.Range(r.Cells(2, 5), r.Cells(rsonsat, rsonsut)).ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To rsonsat
    For sh = 1 To ThisWorkbook.Sheets.Count
        If Sheets(sh).Name <> "rapor" And Sheets(sh).Name <> "öğretmen" Then
            Set varmi = Sheets(sh).[B:B].Find(r.Cells(sat, 4), LookAt:=xlWhole)
            If Not varmi Is Nothing Then
                If Sheets(sh).Cells(varmi.Row, 6) > 0 Then
                    ders = Sheets(sh).Cells(varmi.Row, 3)
                    saat = Sheets(sh).Cells(varmi.Row, 6)
                End If
                If WorksheetFunction.CountIf(r.[1:1], ders) > 0 Then
                    sut = WorksheetFunction.Match(ders, r.[1:1], 0)
                    r.Cells(sat, sut) = r.Cells(sat, sut) + saat
                End If: End If: End If
Next: Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "..:: Ömer BARAN ::.."
[B][COLOR="Blue"]End Sub[/COLOR][/B]
Genişletmek için tıkla ...
Hocam elinize sağlık, doğru bir şekilde çalışıyor makro. Elinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst