Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Fonksiyonlar
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Fonksiyonlar Bir fonksiyonun, nasıl işlediğini veya aradığınız bir işleme uygun olup olmadığını bu başlık altında sorabilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 06-01-2018, 21:43   #1
obsesyonur
 
Giriş: 02/12/2011
Şehir: istanbul
Mesaj: 16
Excel Vers. ve Dili:
2003 türkçe
Question Birden fazla sayfadan çoketopla

Herkese iyi akşamlar,benim sorum;

Sayfa1'in, Sayfa2'nin ve Sayfa3'ün (A) sütunundaki değerleri tekrarsız olarak Sayfa4' e A1' den başlayarak sıralı olarak yazdırıp,yazdırılan bu değerlerin yanına yani (B) sütununa tüm sayfalardaki toplamını formül veya makro ile yazdırmaktır.
Örneğin tüm sayfalarda a değeri beş kerede geçse sayfa 4'ün a1 hücresine bir adet a değeri yazdırıp a değerinin tüm sayfalardaki sayısal değerinin toplamını b1 hücresine yazdırmak şeklinde özetleyebiliriz.
obsesyonur Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-01-2018, 22:01   #2
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,691
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

Aşağıdaki kodlar her sayfanın A sütununu Sayfa4'ün A sütununa kopyalar. Yinelenenleri kaldırır ve her sayfanın B sütunundaki değerlerin toplamını Sayfa4'ün B sütununa aktarır:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub topla()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
Set s4 = Sheets("Sayfa4")
son1 = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row
son3 = s3.Cells(Rows.Count, "A").End(3).Row
son4 = s4.Cells(Rows.Count, "A").End(3).Row
yeni = s4.Cells(Rows.Count, "A").End(3).Row + 1
If s4.Cells(yeni - 1, "a") = "" Then yeni = yeni - 1
s1.Range("A1:A" & son1).Copy s4.Cells(yeni, "A")
yeni = s4.Cells(Rows.Count, "A").End(3).Row + 1
If s4.Cells(yeni - 1, "a") = "" Then yeni = yeni - 1
s2.Range("A1:A" & son2).Copy s4.Cells(yeni, "A")
yeni = s4.Cells(Rows.Count, "A").End(3).Row + 1
If s4.Cells(yeni - 1, "a") = "" Then yeni = yeni - 1
s3.Range("A1:A" & son3).Copy s4.Cells(yeni, "A")
s4.Range("$A$1:$A$" & son1 + son2 + son3).RemoveDuplicates Columns:=1, Header:=xlNo
son4 = s4.Cells(Rows.Count, "A").End(3).Row
For i = 1 To son4
    s4.Cells(i, "B") = WorksheetFunction.SumIf(s1.Range("A1:A" & son1), s4.Cells(i, "A"), s1.Range("B1:B" & son1)) + _
                      WorksheetFunction.SumIf(s2.Range("A1:A" & son2), s4.Cells(i, "A"), s2.Range("B1:B" & son2)) + _
                      WorksheetFunction.SumIf(s3.Range("A1:A" & son3), s4.Cells(i, "A"), s3.Range("B1:B" & son3))
Next
End Sub
__________________


Sorularınızı örnek dosyayla desteklemeniz çözüme ulaşmanızı kolaylaştırır.

Altın Üye olmanızı öneririm. Altın Üye değilseniz dosyanızı dosya yükleme sitelerinden birine yükleyip linkini paylaşabilirsiniz.
YUSUF44 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 21-01-2018, 04:57   #3
obsesyonur
 
Giriş: 02/12/2011
Şehir: istanbul
Mesaj: 16
Excel Vers. ve Dili:
2003 türkçe
Question Birden fazla sayfadan çoketopla

Sayın Yusuf44 öncelikle soruma vermiş olduğunuz cevap için; biraz geç olmakla beraber, teşekkür ederim. Soruma cevaben verdiğiniz kodlar tam istediğim gibi çalışmakta,fakat örnekteki sayfa sayısı 4 değilde 400 olsa idi kodları tek tek her sayfa için ayrı ayrı yazmak oldukça zor görünüyor,bunun kolay bir yolu var mıdır?
obsesyonur Çevrimdışı   Alıntı Yaparak Cevapla
Eski 21-01-2018, 14:58   #4
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,691
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

Aşağıdaki makroyu deneyiniz:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub topla()
Toplam = "yok"
For i = 1 To Sheets.Count
    If Sheets(i).Name = "Toplam" Then
        Toplam = "var"
    End If
Next

If Toplam = "yok" Then
    MsgBox "Dosyanızda Toplam sayfası bulunmamaktadır. " & Chr(10) & _
        "Öncelikle Toplam Sayfası oluşturmanız gerekmektedir.", vbCritical
    Exit Sub
Else
    Application.ScreenUpdating = False
    Set s1 = Sheets("Toplam")
    For sayfa = 1 To Sheets.Count
        If Sheets(sayfa).Name <> "Toplam" Then
            son = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
            yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
            If s1.Cells(yeni - 1, "A") = "" Then yeni = yeni - 1
            Sheets(sayfa).Range("A1:A" & son).Copy s1.Cells(yeni, "A")
            yeni1 = s1.Cells(Rows.Count, "A").End(3).Row
            s1.Range("$A$1:$A$" & yeni1).RemoveDuplicates Columns:=1, Header:=xlNo
        End If
    Next
    son1 = s1.Cells(Rows.Count, "A").End(3).Row
    For j = 1 To son1
        sonuç = 0
        For k = 1 To Sheets.Count
            son2 = Sheets(k).Cells(Rows.Count, "A").End(3).Row
            sonuç = sonuç + WorksheetFunction.SumIf(Sheets(k).Range("A1:A" & son2), s1.Cells(j, "A"), Sheets(k).Range("B1:B" & son2))
        Next
        s1.Cells(j, "B") = sonuç
    Next
    Application.ScreenUpdating = True
End If
End Sub
__________________


Sorularınızı örnek dosyayla desteklemeniz çözüme ulaşmanızı kolaylaştırır.

Altın Üye olmanızı öneririm. Altın Üye değilseniz dosyanızı dosya yükleme sitelerinden birine yükleyip linkini paylaşabilirsiniz.
YUSUF44 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-01-2018, 22:44   #5
obsesyonur
 
Giriş: 02/12/2011
Şehir: istanbul
Mesaj: 16
Excel Vers. ve Dili:
2003 türkçe
Question Birden fazla sayfadan çoketopla

Sayın Yusuf44 cevabınız için çok teşekkür ederim,verdiğiniz makro kodunu toplam sayfasında oluşturduğum bir butona atayarak istediğim işlemi gerçekleştirebiliyorum,fakat söz konusu butona her tıkladığımda, değerleri bir kez daha topluyor,acaba sizin verdiğiniz koda bir ilave yapılarak, butona bastığımızda, toplam sayfasının içeriğini temizlese daha sonra verileri süzüp toplamlarını alsa,bu olanaklı mıdır?
Örnek dosya indirme linki : http://www.dosya.tc/server11/ggshxi/...riler.rar.html

Bu mesaj en son " 25-01-2018 " tarihinde saat 22:48 itibariyle obsesyonur tarafından düzenlenmiştir.... Neden: örnek dosya ekleme
obsesyonur Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-01-2018, 23:30   #6
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,691
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

Aşağıdaki gibi deneyin (dosyanıza bakmadım, eski kodu isteğinize göre güncelledim sadece):

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub topla()
Toplam = "yok"
For i = 1 To Sheets.Count
    If Sheets(i).Name = "Toplam" Then
        Toplam = "var"
    End If
Next

If Toplam = "yok" Then
    MsgBox "Dosyanızda Toplam sayfası bulunmamaktadır. " & Chr(10) & _
        "Öncelikle Toplam Sayfası oluşturmanız gerekmektedir.", vbCritical
    Exit Sub
Else
    Application.ScreenUpdating = False
    Set s1 = Sheets("Toplam")
    eski = s1.Cells(Rows.Count, "A").End(3).Row
    s1.Range("A1:B" & eski) = ""
    For sayfa = 1 To Sheets.Count
        If Sheets(sayfa).Name <> "Toplam" Then
            son = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
            yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
            If s1.Cells(yeni - 1, "A") = "" Then yeni = yeni - 1
            Sheets(sayfa).Range("A1:A" & son).Copy s1.Cells(yeni, "A")
            yeni1 = s1.Cells(Rows.Count, "A").End(3).Row
            s1.Range("$A$1:$A$" & yeni1).RemoveDuplicates Columns:=1, Header:=xlNo
        End If
    Next
    son1 = s1.Cells(Rows.Count, "A").End(3).Row
    For j = 1 To son1
        sonuç = 0
        For k = 1 To Sheets.Count
            son2 = Sheets(k).Cells(Rows.Count, "A").End(3).Row
            sonuç = sonuç + WorksheetFunction.SumIf(Sheets(k).Range("A1:A" & son2), s1.Cells(j, "A"), Sheets(k).Range("B1:B" & son2))
        Next
        s1.Cells(j, "B") = sonuç
    Next
    Application.ScreenUpdating = True
End If
End Sub
__________________


Sorularınızı örnek dosyayla desteklemeniz çözüme ulaşmanızı kolaylaştırır.

Altın Üye olmanızı öneririm. Altın Üye değilseniz dosyanızı dosya yükleme sitelerinden birine yükleyip linkini paylaşabilirsiniz.
YUSUF44 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-01-2018, 00:44   #7
obsesyonur
 
Giriş: 02/12/2011
Şehir: istanbul
Mesaj: 16
Excel Vers. ve Dili:
2003 türkçe
Thumbs up Çözüldü;Birden fazla sayfadan çoketopla

Sayın Yusuf44 cevabınız ve göstermiş olduğunuz ilgi için çok teşekkür ederim,düzenlediğiniz makro kodu tam olarak istenilen şekilde çalışmaktadır,ayrıca ilgi duyduğum vba kodlama dilini öğrenmeye başlamak için nasıl bir yol izlemeliyim,önerinizi sabırsızlıkla bekliyorum.İyi geceler.
obsesyonur Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 14:04


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Perde- Çorlu Havuz- Çorlu Havuz- Makina- Danışmazlar- Çorlu Perde Yıkama- Çorlu Perde Yıkama- Okul Danışmanlık- Çorlu Ayakkabı- İzmit Sigorta- ADR'li taşıma kabı imalatı- Mekanik Tesisat- Çorlu Grafik Tasarım-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden