Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


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

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 12-01-2018, 18:09   #1
uKiGS
Altın Üye
 
Giriş: 03/03/2008
Mesaj: 109
Excel Vers. ve Dili:
2013 ingilizce
Varsayılan Yemek Listesi

Merhaba,

aylık yemek listesi yapmak istiyorum otomatik olarak. Mesala Pazartesi verilen yemekleri o hafta içinde bir daha tekrarlamasın istiyorum. Bunu yapmak mümkün müdür?
uKiGS Çevrimiçi   Alıntı Yaparak Cevapla
Eski 12-01-2018, 18:32   #2
Tevfik_Kursun
Altın Üye
 
Giriş: 30/07/2012
Şehir: Antakya
Mesaj: 1,175
Excel Vers. ve Dili:
2010 - Türkçe 64 Bit
Varsayılan

Merhaba,
Ne olmasını istiyorsanız bir örneğini hazırlayın, arkadaşlarımız yardımcı olur
İyi çalışmalar
Tevfik_Kursun Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-01-2018, 18:47   #3
uKiGS
Altın Üye
 
Giriş: 03/03/2008
Mesaj: 109
Excel Vers. ve Dili:
2013 ingilizce
Varsayılan

Dediğim gibi Sayfa 1 de verilecek yemeklerin listesi var sayfa 2 de günlük tabloya verilecek yemekleri otomatik olarak dağıtmasını istiyorum. Çorba kısmından 1 yemek Ana yemek 1 yazan kısımdan 1 yemek ve ana yemek 2 yazan kısımdan 1 yemek. ama istediğim şu bu yemekleri aynı hafta içinde tekrarlamasın.
Eklenmiş Dosyalar
Dosya Türü: xlsx Yemek Listesi.xlsx (11.7 KB, 18 Görüntülenme)
uKiGS Çevrimiçi   Alıntı Yaparak Cevapla
Eski 12-01-2018, 20:33   #4
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,482
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 yemek()
Set s1 = Sheets("Yemek Liste")
Set s2 = Sheets("Şubat Liste")
çorbason = s1.Cells(Rows.Count, "A").End(3).Row
ana1son = s1.Cells(Rows.Count, "C").End(3).Row
ana2son = s1.Cells(Rows.Count, "E").End(3).Row

For hafta = 1 To 25 Step 6
    For gün = 1 To 5
        If IsDate(s2.Cells(hafta, gün)) = True Then
10:
            çorba = WorksheetFunction.RandBetween(2, çorbason)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(çorba, "A")) = 0 Then
                s2.Cells(hafta + 1, gün) = s1.Cells(çorba, "A")
                s1.Cells(çorba, "B") = s1.Cells(çorba, "B") + 1
            Else
                GoTo 10
            End If
20:
            ana1 = WorksheetFunction.RandBetween(2, ana1son)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(ana1, "C")) = 0 Then
                s2.Cells(hafta + 2, gün) = s1.Cells(ana1, "C")
                s1.Cells(ana1, "D") = s1.Cells(ana1, "D") + 1
            Else
                GoTo 20
            End If
30:
            ana2 = WorksheetFunction.RandBetween(2, ana2son)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(ana2, "E")) = 0 Then
                s2.Cells(hafta + 3, gün) = s1.Cells(ana2, "E")
                s1.Cells(ana2, "F") = s1.Cells(ana2, "F") + 1
            Else
                GoTo 30
            End If
        End If
    Next
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 Çevrimiçi   Alıntı Yaparak Cevapla
Eski 12-01-2018, 20:45   #5
uKiGS
Altın Üye
 
Giriş: 03/03/2008
Mesaj: 109
Excel Vers. ve Dili:
2013 ingilizce
Varsayılan

öncelikle vermiş olduğunuz cevap için teşekkürler Sayın Yusuf,

vermiş olduğunuz makroyu denedim fakat çok bilmediğim için bir değişiklikte olmadı listede. ben istiyorum ki bir tuş yardımıyla otomatik olarak haftalık ya da aylık doldursun listeyi mümkün müdür?
uKiGS Çevrimiçi   Alıntı Yaparak Cevapla
Eski 12-01-2018, 21:07   #6
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,482
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

kodda biraz değişiklik yaptım. amacım her yemek çeşidinden en az bir kez yararlanılmasını sağlamak. Bunun için aşağıdaki kodları hazırladım:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub yemek()
Set s1 = Sheets("Yemek Liste")
Set s2 = Sheets("Şubat Liste")
çorbason = s1.Cells(Rows.Count, "A").End(3).Row
ana1son = s1.Cells(Rows.Count, "C").End(3).Row
ana2son = s1.Cells(Rows.Count, "E").End(3).Row

s1.Range("B2:B" & çorbason) = ""
s1.Range("D2:D" & ana1son) = ""
s1.Range("F2:F" & ana2son) = ""

s2.Range("A2:E6, A8:E12, A14:E18, A20:E24, A26:E30") = ""

öğün = WorksheetFunction.Count(s2.[A1:E30])
çorbaçeşidi = Int(öğün / (çorbason - 1)) + 1
ana1çeşidi = Int(öğün / (ana1son - 1)) + 1
ana2çeşidi = Int(öğün / (ana2son - 1)) + 1

For hafta = 1 To 25 Step 6
    For gün = 1 To 5
        If IsDate(s2.Cells(hafta, gün)) = True Then
10:
            çorba = WorksheetFunction.RandBetween(2, çorbason)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(çorba, "A")) = 0 And _
                s1.Cells(çorba, "B") < çorbaçeşidi Then
                s2.Cells(hafta + 1, gün) = s1.Cells(çorba, "A")
                s1.Cells(çorba, "B") = s1.Cells(çorba, "B") + 1
            Else
                GoTo 10
            End If
20:
            ana1 = WorksheetFunction.RandBetween(2, ana1son)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(ana1, "C")) = 0 And _
                s1.Cells(ana1, "D") < ana1çeşidi Then
                s2.Cells(hafta + 2, gün) = s1.Cells(ana1, "C")
                s1.Cells(ana1, "D") = s1.Cells(ana1, "D") + 1
            Else
                GoTo 20
            End If
30:
            ana2 = WorksheetFunction.RandBetween(2, ana2son)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(ana2, "E")) = 0 And _
                s1.Cells(ana2, "F") < ana2çeşidi Then
                s2.Cells(hafta + 3, gün) = s1.Cells(ana2, "E")
                s1.Cells(ana2, "F") = s1.Cells(ana2, "F") + 1
            Else
                GoTo 30
            End If
        End If
    Next
Next
            
End Sub
Ancak maalesef benim bilgisayarım bu makroyu çalıştırdığımda hep dondu. Tam çalışmasının sonucunu inceleyemedim. Sizde de hata olursa aşağıdaki kodları kullanın:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub yemek()
Set s1 = Sheets("Yemek Liste")
Set s2 = Sheets("Şubat Liste")
çorbason = s1.Cells(Rows.Count, "A").End(3).Row
ana1son = s1.Cells(Rows.Count, "C").End(3).Row
ana2son = s1.Cells(Rows.Count, "E").End(3).Row

s1.Range("B2:B" & çorbason) = ""
s1.Range("D2:D" & ana1son) = ""
s1.Range("F2:F" & ana2son) = ""

s2.Range("A2:E6, A8:E12, A14:E18, A20:E24, A26:E30") = ""

öğün = WorksheetFunction.Count(s2.[A1:E30])
çorbaçeşidi = Int(öğün / (çorbason - 1)) + 1
ana1çeşidi = Int(öğün / (ana1son - 1)) + 1
ana2çeşidi = Int(öğün / (ana2son - 1)) + 1

For hafta = 1 To 25 Step 6
    For gün = 1 To 5
        If IsDate(s2.Cells(hafta, gün)) = True Then
10:
            çorba = WorksheetFunction.RandBetween(2, çorbason)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(çorba, "A")) = 0 Then
                s2.Cells(hafta + 1, gün) = s1.Cells(çorba, "A")
                s1.Cells(çorba, "B") = s1.Cells(çorba, "B") + 1
            Else
                GoTo 10
            End If
20:
            ana1 = WorksheetFunction.RandBetween(2, ana1son)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(ana1, "C")) = 0 Then
                s2.Cells(hafta + 2, gün) = s1.Cells(ana1, "C")
                s1.Cells(ana1, "D") = s1.Cells(ana1, "D") + 1
            Else
                GoTo 20
            End If
30:
            ana2 = WorksheetFunction.RandBetween(2, ana2son)
            If WorksheetFunction.CountIf(s2.Range("A" & hafta + 1 & ":E" & hafta + 5), s1.Cells(ana2, "E")) = 0 Then
                s2.Cells(hafta + 3, gün) = s1.Cells(ana2, "E")
                s1.Cells(ana2, "F") = s1.Cells(ana2, "F") + 1
            Else
                GoTo 30
            End If
        End If
    Next
Next
            
End Sub
Makronun nasıl çalıştırılacağına gelince:

Kodları kopyalayın.
Excel dosyanızda Alt+F11 yapın, VBA penceresi açılacak
Bu pencerede Insert menüsünden Module'yi seçin
Kodları açılan sayfaya yapıştırın

Excel sayfanıza geçin.
Sayfaya bir resim/düğme/nesne ekleyin
Eklediğinize sağ tıklayıp Makro ata deyin
Açılan listeden "yemek" adlı makroyu seçip tamam deyin.

Bundan sonra o eklediğiniz düğme/nesne/resme tıkladığınızda makro çalışacaktır.

Makronun daha sonra da çalışabilmesi için dosyanızı Makro içerebilen excel dosyası olarak farklı kaydetmeyi unutmayın. Uzantısı xlsm olacak.
__________________


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 Çevrimiçi   Alıntı Yaparak Cevapla
Eski 12-01-2018, 21:07   #7
Tevfik_Kursun
Altın Üye
 
Giriş: 30/07/2012
Şehir: Antakya
Mesaj: 1,175
Excel Vers. ve Dili:
2010 - Türkçe 64 Bit
Varsayılan

Merhaba,
İstediğiniz dosya ekte
Zahmet olmuş Yusuf44 Hocam, teşekkürler
Kolay gelsin
Eklenmiş Dosyalar
Dosya Türü: xlsm Yemek Listesi.xlsm (25.5 KB, 11 Görüntülenme)
Tevfik_Kursun Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-01-2018, 21:10   #8
cems
Altın Üye
 
cems kullanıcısının avatarı
 
Giriş: 02/09/2005
Şehir: İstanbul
Mesaj: 1,705
Excel Vers. ve Dili:
office 2003 tr + office 2010 tr
Varsayılan

Alıntı:
uKiGS tarafından gönderildi Mesajı Görüntüle
bir tuş yardımıyla otomatik olarak haftalık ya da aylık doldursun listeyi mümkün müdür?
Sayın YUSUF44' ün verdiği kodlar tam da bu işi yapıyor , hafta içinde tekrar eden yemek yok ve bir aylık listeyi çıkarıyor.

Tuş hemen tablonun yanında , öncelikle dosyayı farklı kaydet esnasında " makro kaydedilebilir" türe çevirmeniz ve kodları bir tuş nesnesinin altına yerleştirmeniz yeterdi.

Bu şekilde hazırlanmış dosya ekte . Gerisi sizin yemek listesini uzatmanıza bağlı .

Alıntı:
benim bilgisayarım bu makroyu çalıştırdığımda hep dondu. Tam çalışmasının sonucunu inceleyemedim.
Sayın YUSUF44 3 kod da bende sorunsuz çalıştı ve hafta içinde hiç birinde mükerrer çıkarmadı. Sayenizde liste değil sanki tabaklar uçuştu ,bu saatte acıktığımı hatırladım
Eklenmiş Dosyalar
Dosya Türü: xlsm Yemek Listesi.xlsm (25.6 KB, 11 Görüntülenme)

Bu mesaj en son " 12-01-2018 " tarihinde saat 21:22 itibariyle cems tarafından düzenlenmiştir....
cems Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-01-2018, 21:15   #9
uKiGS
Altın Üye
 
Giriş: 03/03/2008
Mesaj: 109
Excel Vers. ve Dili:
2013 ingilizce
Varsayılan

Hepinize ayrı ayrı çok teşekkür ederim. Beni büyük bir zahmetten kurtarmış oldunuz çok sağolun
uKiGS Çevrimiçi   Alıntı Yaparak Cevapla
Eski 12-01-2018, 21:22   #10
uKiGS
Altın Üye
 
Giriş: 03/03/2008
Mesaj: 109
Excel Vers. ve Dili:
2013 ingilizce
Varsayılan

Sayın Yusuf bir soru daha sormak istiyorum. ben bunu her ay düzenli olarak yapmak için ne yapmayalım ? elle değiştirmekten başka otomatik olarak Mart ayı geldiğinde yeni liste yapabilir miyiz?
uKiGS Çevrimiçi   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 09:52


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 - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Dil 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- Kaplan Tekstil- Çorlu Perde- Çorlu Havuz- Makina- Danışmazlar-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden