Makrolu Yemek Listesi Düzenleme

[CrAzY_4343]

Merhabalar Üstadlarım.

Çözemediğim bir durum var. Dosyayı ekliyorum fakat kısaca özetleyeyim.

Ekli Dosyada göreceğiniz üzere çeşitli sayfalarım var. Aslında şimdilik bunlarda yalnızca ikisiyle çalışıcam. "Menü Hazırla" ve "Çorbalar"... Menu hazırla sayfasında aya göre otomatik olarak getirdiğim tarihlerin karşısına yemekler yazılacak. Bu yemekler çıktı sayfasında liste haline formüller ile geliyor. Yapmak istediğim şey ise şu : Ben bütün listeyi doldurduğumda, bir buton aracılığı ile çorbalar sayfasına çorbalar benzersiz olarak ilgili sütuna atılsın. Sonra bu çorbalar hangi ay içerisinde ise kaç kez hangi güne yazılmışsa ilgili hücreye sayısı yazılsın.

Üstteki resimde formülle yaptım ancak her aya yapılması gerektiğini düşününce kasmaması ve bilgininin kalıcı olması gerektiğinden makro ile yapılması şart gibi duruyor. İşte bunu da ben yapamadım.

Kısaca hangi ayın menusu düzenleniyorsa aya göre, çorbaya göre, haftanın gününe göre sayıp kaydedecek bir buton makrosuna ihtiyacım var. Yardımlarınızı bekliyorum.

 

[CrAzY_4343]

Üstte kalması için güncelliyorum. Yardıma ihtiyacım var.

 

[halit3]

Alternatif olarak aşağıdaki linklerdeki dosyaları irdeleyiniz.

http://www.excel.web.tr/f50/gunluk-yemek-cizelgesi-t82295.html
http://www.excel.web.tr/f14/yemek-tabelasy-t84087.html

 

[CrAzY_4343]

Halit Bey teşekkür ederim ama dosyanız benim olayımdan farklı. Önceki dosyalarla benim projemi uyarlamam sanırım. Projemi indirirseniz daha net anlayacaksınız.

 

[CrAzY_4343]

Burdan da normal olarak indirebilirsiniz.

 

[halit3]

Ekli dosyayı kontrol edin

ÇORBALAR sayfasındaki aylara ait format şöyle olmalı Ocak ,Şubat gibi
günlere ait formatda şöyle olmalı Pazartesi ,Salı gibi

kod:

Sub aktar()

Worksheets("ÇORBALAR").Range("B3:CG31").ClearContents

For r = 3 To Worksheets("ÇORBALAR").Cells(Rows.Count, "A").End(3).Row
aranan1 = Worksheets("ÇORBALAR").Cells(r, "A").Value

For j = 10 To Worksheets("MENU HAZIRLA").Cells(Rows.Count, "a").End(3).Row

  aranan2 = Format(Worksheets("MENU HAZIRLA").Cells(j, "a").Value, "dddd")
    aranan3 = Format(Worksheets("MENU HAZIRLA").Cells(j, "a").Value, "mmmm")

    For i = 4 To 7
    bulunan1 = Worksheets("MENU HAZIRLA").Cells(j, i).Value
   
    If aranan1 = bulunan1 Then

  
    
        For m = 2 To 85 Step 7
        bulunan2 = Worksheets("ÇORBALAR").Cells(1, m).Value
        
            If aranan3 = bulunan2 Then
            For n = m To m + 6
            
            bulunan3 = Format(Worksheets("ÇORBALAR").Cells(2, n).Value, "dddd")
              
            If aranan2 = bulunan3 Then
        
            Worksheets("ÇORBALAR").Cells(r, n).Value = Worksheets("ÇORBALAR").Cells(r, n).Value + 1
         
            End If
            Next n
            End If
        
        Next m
    
    End If
    
    Next i
Next j
Next r


MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

 

[muygun]

Merhaba;
Halit Bey soruyu cevaplamış ama hazırladığım örnek alternatif olsun.
İnceleyin.
İyi çalışmalar.

 

[halit3]

Bu kod da sizin mevcut dosyanızda günleri ve ayları değiştirme ihtiyacı olmadan çalışması lazım.

Sub aktar2()

'Worksheets("ÇORBALAR").Range("B3:CG31").ClearContents
sil1 = Worksheets("MENU HAZIRLA").Cells(2, 4).Value

For s = 2 To 85 Step 7
sil2 = Evaluate("=UPPER(""" & Format(Worksheets("ÇORBALAR").Cells(1, s).Value, "mmmm") & """)")
If sil1 = sil2 Then
Worksheets("ÇORBALAR").Range(Worksheets("ÇORBALAR").Cells(3, s), Worksheets("ÇORBALAR").Cells(31, s + 6)).ClearContents
Exit For
End If
Next s


For r = 3 To Worksheets("ÇORBALAR").Cells(Rows.Count, "A").End(3).Row
aranan1 = Worksheets("ÇORBALAR").Cells(r, "A").Value

For j = 10 To Worksheets("MENU HAZIRLA").Cells(Rows.Count, "a").End(3).Row
aranan2 = Evaluate("=UPPER(""" & Format(Worksheets("MENU HAZIRLA").Cells(j, "a").Value, "dddd") & """)")
aranan3 = Evaluate("=UPPER(""" & Format(Worksheets("MENU HAZIRLA").Cells(j, "a").Value, "mmmm") & """)")

For i = 4 To 7
bulunan1 = Worksheets("MENU HAZIRLA").Cells(j, i).Value

If aranan1 = bulunan1 Then
For m = 2 To 85 Step 7
bulunan2 = Evaluate("=UPPER(""" & Format(Worksheets("ÇORBALAR").Cells(1, m).Value, "mmmm") & """)")
If aranan3 = bulunan2 Then

For n = m To m + 6
bulunan3 = Evaluate("=UPPER(""" & Format(Worksheets("ÇORBALAR").Cells(2, n).Value, "dddd") & """)")
If aranan2 = bulunan3 Then
Worksheets("ÇORBALAR").Cells(r, n).Value = Worksheets("ÇORBALAR").Cells(r, n).Value + 1
End If
Next n

End If
Next m
End If

Next i
Next j
Next r


MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

 

[CrAzY_4343]

Üstadlarım ellerinize sağlık. İki çalışmada harika olmuşlar. Özellikle @muygun hocam senin hazırladığın benim ihtiyaçlarımı tam anlamıyla karşılıyor. Elinize yüreğinize sağlık.