Aktarma Makro'sunda Düzenleme (Seçime Göre)

1Al2Ver · 13 Temmuz 2016

Merhabalar,

Sayın Ömer BARAN'ın yazdığı kod ile, "REÇETE" sayfası "E" sütunundan, "RAPOR" sayfası "E" sütunun ilgili hücrelerine veri alıyorum,

İhtiyaç üzerine tek sütundan (E) alınan miktarların, "RAPOR" sayfası N1 hücresinden yapılacak seçime göre, "REÇETE" sayfasından (E,F,G) "RAPOR" sayfasının ilgili hücrelerine gelmesini arzuluyorum,

NOT ; "RAPOR" sayfasında C60 son satır olarak tanımlanmış olduğundan, veriler 59.satıra kadar alınmaktadır.

Teşekkür ederim.

Kod:

Sub MENÜ_LİSTELE()
Set ra = Sheets("RAPOR"): Set RE = Sheets("REÇETE")
If ra.[C60].End(3).Row > 16 Then ra.Range("A17:I" & ra.[C59].End(3).Row).ClearContents
For yemek = 3 To ra.[I16].End(3).Row
Cells(ra.[C60].End(3).Row + 1, 2) = ra.Cells(yemek, 9)
    ilk = WorksheetFunction.Match(ra.Cells(yemek, 9), RE.Range("B:B"), 0)
    son = WorksheetFunction.CountIf(RE.Range("B:B"), ra.Cells(yemek, 9)) + ilk - 1
    For resat = ilk To son
        rasat = ra.[C60].End(3).Row + 1: ra.Cells(rasat, 3) = RE.Cells(resat, 3)
        ra.Cells(rasat, 4) = RE.Cells(resat, 4): ra.Cells(rasat, 5) = RE.Cells(resat, 5)
        
        If Cells(rasat, 4) = "Gr" Then
            katsayı = 1000
            ra.Cells(rasat, 6) = ra.[D14] * ra.Cells(rasat, 5) / katsayı
            ra.Cells(rasat, 7) = RE.Cells(resat, 6)
            ra.Cells(rasat, 8) = RE.Cells(resat, 7) * ra.[D14]
        Else
            katsayı = 1
            ra.Cells(rasat, 6) = ra.[D14] * ra.Cells(rasat, 5) / katsayı
            ra.Cells(rasat, 7) = RE.Cells(resat, 6)
            ra.Cells(rasat, 8) = RE.Cells(resat, 7) * ra.[D14] * katsayı * 1000
        End If

        ra.Cells(rasat, 9) = RE.Cells(resat, 8)
    Next
Next
With ra.Range("A17:A" & ra.[C60].End(3).Row)
    .Formula = "=IF(ISERROR(MATCH(B17,$I$1:$I$14,0)),"""",MAX($A$16:A16)+1)"
    .Value = .Value
End With
ra.Cells(ra.[C60].End(3).Row + 1, 6) = "TOPLAM"
ra.Cells(ra.[C60].End(3).Row + 1, 8) = _
        WorksheetFunction.Sum(ra.Range("H17:H" & ra.[C60].End(3).Row))
ra.Cells(ra.[C60].End(3).Row + 1, 9) = _
        WorksheetFunction.Sum(ra.Range("I17:I" & ra.[C60].End(3).Row))
MsgBox "İŞLEM TAMAM"
End Sub

Ömer BARAN · 13 Temmuz 2016

Merhaba.

Mevcut LİSTELE kod'unu aşağıdakiyle değiştirdiğinizde istediğinizin olması lazım.
.

Kod:

[FONT="Arial Narrow"]Sub MENÜ_LİSTELE()
Set ra = Sheets("RAPOR"): Set RE = Sheets("REÇETE")
If ra.[C60].End(3).Row > 16 Then ra.Range("A17:I" & ra.[C59].End(3).Row).ClearContents
    Select Case ra.[N1]
        Case Is = "Düşük": hedef = 5
        Case Is = "Orta": hedef = 6
        Case Is = "Yüksek": hedef = 7
    End Select
For yemek = 3 To ra.[I16].End(3).Row
Cells(ra.[C60].End(3).Row + 1, 2) = ra.Cells(yemek, 9)
    ilk = WorksheetFunction.Match(ra.Cells(yemek, 9), RE.Range("B:B"), 0)
    son = WorksheetFunction.CountIf(RE.Range("B:B"), ra.Cells(yemek, 9)) + ilk - 1
    For resat = ilk To son
        rasat = ra.[C60].End(3).Row + 1: ra.Cells(rasat, 3) = RE.Cells(resat, 3)
        ra.Cells(rasat, 4) = RE.Cells(resat, 4): ra.Cells(rasat, 5) = RE.Cells(resat, hedef)
        
        If Cells(rasat, 4) = "Gr" Then
            ra.Cells(rasat, 6) = ra.[D14] * ra.Cells(rasat, 5) / 1000
            ra.Cells(rasat, 8) = [COLOR="blue"](RE.Cells(resat, 8) * RE.Cells(resat, hedef) / 1000)[/COLOR] * ra.[D14]
        Else
            ra.Cells(rasat, 6) = ra.[D14] * ra.Cells(rasat, 5)
            ra.Cells(rasat, 8) = [COLOR="Blue"](RE.Cells(resat, 8) * RE.Cells(resat, hedef) / 1000)[/COLOR] * ra.[D14] * 1000
        End If
        ra.Cells(rasat, 7) = RE.Cells(resat, 8): ra.Cells(rasat, 9) = RE.Cells(resat, [B][COLOR="Red"]hedef + 5[/COLOR][/B])
    Next
Next
With ra.Range("A17:A" & ra.[C60].End(3).Row)
    .Formula = "=IF(ISERROR(MATCH(B17,$I$1:$I$14,0)),"""",MAX($A$16:A16)+1)": .Value = .Value
End With
ra.Cells(ra.[C60].End(3).Row + 1, 6) = "TOPLAM"
ra.Cells(ra.[C60].End(3).Row + 1, 8) = _
        WorksheetFunction.Sum(ra.Range("H17:H" & ra.[C60].End(3).Row))
ra.Cells(ra.[C60].End(3).Row + 1, 9) = _
        WorksheetFunction.Sum(ra.Range("I17:I" & ra.[C60].End(3).Row))
MsgBox "İŞLEM TAMAM"
End Sub[/FONT]

1Al2Ver · 13 Temmuz 2016

Sayın Ömer BARAN merhaba,

Çok teşekkür ederim, kod sorunsuz çalışıyor, elinize sağlık, sağlıkla kalın.

Saygılarımla.

Ömer BARAN · 13 Temmuz 2016

1Al2Ver' Alıntı:
Sayın Ömer BARAN merhaba,

Çok teşekkür ederim, kod sorunsuz çalışıyor, elinize sağlık, sağlıkla kalın.

Saygılarımla.

Estağfurullah, iyi günler dilerim.

Kod ile ilgili olarak dikkat edilecek husus, REÇETE sayfasındaki
=(H2/1000)*E2 formülünün kod içerisine alınarak hesaplamanın orada yapıldığı hususudur.

Önceki cevabımda buna ilişkin kısımları mavi renklendirdim.
.

1Al2Ver · 14 Temmuz 2016

Ömer BARAN' Alıntı:
Estağfurullah, iyi günler dilerim.

Kod ile ilgili olarak dikkat edilecek husus, REÇETE sayfasındaki
=(H2/1000)*E2 formülünün kod içerisine alınarak hesaplamanın orada yapıldığı hususudur.

Önceki cevabımda buna ilişkin kısımları mavi renklendirdim.
.

Sayın Ömer BARAN merhaba,

Açıklama için teşekkür ederim,

Burada önceden akıl edemediği, ancak az önce olması gerektiğini anladığım bir ihtiyacım doğdu,

Malum seçime göre miktarları aldık ama, yapılan seçime göre kalori miktarlarınında, azalıp-artması gerekiyor,

Sanırım bir döngü daha kurulacak, bir-iki deneme yaptım olmadı,

Zahmet olmaz ise ve vaktiniz müsait olduğunda, bunu da yapabilirsek, memnun olurum, hem de önceki kod ile sonraki kodu karşılaştırıp mantığı da çözebilirim.

Tekrar teşekkür ederim.

Ömer BARAN · 14 Temmuz 2016

Tekrar merhaba.

Bu işlem için öyle çok işleme lüzum yok.
Önceki kod cevabımda kırmızı renklendirdiğim kısımı değiştirmeniz yeterli olur.
Neticede RAPOR sayfasındaki kalori sütununa (9'uncu sütun yani I sütunu) yazılacak değer,
REÇETE sayfasındaki kişi başı miktar sütununun (koddaki hedef değişkeni) 5 sütun sonrası değil mi?

Sonradan ilave not: Bu arada TOPLAM satırı ile ilgili isteğinizi yeni gördüm, elbette halledilebilir ancak,
benim önerim; bu tür TOPLAM gibi özet bilgilerin tabloların altına değil tam aksine üstüne almak yönündedir.
Böylece hem bu tür özet bilgiler her zaman göz önünde olur hem de aktarılan veri için satır sayısı sınırı da ortadan kalkmış olur.
.

1Al2Ver · 14 Temmuz 2016

Sayın Ömer BARAN merhaba,

Çok çok teşekkür ederim, çözümleriniz ve açıklamalı önerileriniz için.

Görüşmek umuduyla, sağlıkla kalın.

Saygılarımla.

1Al2Ver · 19 Temmuz 2016

Merhaba,

Aşağıdaki kod'da 4.sütunda "Gr" olanlar için hesaplama var,

Bu sütunda "Ad", "Demet", "Poşet" vb. olanların "REÇETE" sayfasında 1/5, 1/11, 1/60 gibi değerleri var, bu gibi değerleri "RAPOR" sayfasındaki ilgili sütunda 0,020 vb, gibi değil de "REÇETE" sayfasındaki haliyle ( 1/5, 1/11, 1/60 vb) görmek mümkün mü ?

Teşekkür ederim.

Kod:

Sub MENÜ_LİSTELE()
Set ra = Sheets("RAPOR"): Set RE = Sheets("REÇETE")
If ra.[C60].End(3).Row > 16 Then ra.Range("A17:I" & ra.[C59].End(3).Row).ClearContents
    Select Case ra.[N1]
        Case Is = "Düşük": hedef = 5
        Case Is = "Orta": hedef = 6
        Case Is = "Yüksek": hedef = 7
    End Select
For yemek = 3 To ra.[I16].End(3).Row
Cells(ra.[C60].End(3).Row + 1, 2) = ra.Cells(yemek, 9)
    ilk = WorksheetFunction.Match(ra.Cells(yemek, 9), RE.Range("B:B"), 0)
    son = WorksheetFunction.CountIf(RE.Range("B:B"), ra.Cells(yemek, 9)) + ilk - 1
    For resat = ilk To son
        rasat = ra.[C60].End(3).Row + 1: ra.Cells(rasat, 3) = RE.Cells(resat, 3)
        ra.Cells(rasat, 4) = RE.Cells(resat, 4): ra.Cells(rasat, 5) = RE.Cells(resat, hedef)
        
        If Cells(rasat, 4) = "[COLOR="Red"]Gr[/COLOR]" Then
            ra.Cells(rasat, 6) = ra.[D14] * ra.Cells(rasat, 5) / 1000
            ra.Cells(rasat, 8) = (RE.Cells(resat, 8) * RE.Cells(resat, hedef) / 1000) * ra.[D14]
        Else
            ra.Cells(rasat, 6) = ra.[D14] * ra.Cells(rasat, 5)
            ra.Cells(rasat, 8) = (RE.Cells(resat, 8) * RE.Cells(resat, hedef) / 1000) * ra.[D14] * 1000
        End If
        ra.Cells(rasat, 7) = RE.Cells(resat, 8): ra.Cells(rasat, 9) = RE.Cells(resat, hedef + 5)
    Next
Next
With ra.Range("A17:A" & ra.[C60].End(3).Row)
    .Formula = "=IF(ISERROR(MATCH(B17,$I$1:$I$14,0)),"""",MAX($A$16:A16)+1)": .Value = .Value
End With
ra.Cells(ra.[C60].End(3).Row + 1, 6) = "TOPLAM"
ra.Cells(ra.[C60].End(3).Row + 1, 8) = _
        WorksheetFunction.Sum(ra.Range("H17:H" & ra.[C60].End(3).Row))
ra.Cells(ra.[C60].End(3).Row + 1, 9) = _
        WorksheetFunction.Sum(ra.Range("I17:I" & ra.[C60].End(3).Row))
MsgBox "İŞLEM TAMAM"
End Sub

Ömer BARAN · 19 Temmuz 2016

Merhaba.

Sanırım RAPOR sayfası E sütunundaki değerlerden bahsediyorsunuz. Kod'daki;
-- Select Case ra.[N1] satırından hemen önce aşağıdaki kırmızı satırı,
-- kırmızı renklendirdiğiniz Gr'nin bulunduğu satırın üstüne de mavi satırı eklemeniz yeterli olur.
.

Kod:

[COLOR="Red"]Cells.NumberFormat = General
[/COLOR]
[COLOR="Blue"]ra.Cells(rasat, 5).NumberFormat = RE.Cells(resat, hedef).NumberFormat[/COLOR]

1Al2Ver · 19 Temmuz 2016

Ömer BARAN' Alıntı:
Merhaba.

Sanırım RAPOR sayfası E sütunundaki değerlerden bahsediyorsunuz. Kod'daki;
-- Select Case ra.[N1] satırından hemen önce aşağıdaki kırmızı satırı,
-- kırmızı renklendirdiğiniz Gr'nin bulunduğu satırın üstüne de mavi satırı eklemeniz yeterli olur.
.

Kod:

[COLOR="Red"]Cells.NumberFormat = General [/COLOR] [COLOR="Blue"]ra.Cells(rasat, 5).NumberFormat = RE.Cells(resat, hedef).NumberFormat[/COLOR]

Ömer bey merhaba,

Teşekkür ederim, misafirim vardı, bakamamıştım, kusuruma bakmayın,

Sayenizde bu problem de çözüldü, minnettarım.

Sağlıkla kalın, saygılarımla.

Ömer BARAN · 20 Temmuz 2016

1Al2Ver' Alıntı:
Ömer bey merhaba,

Teşekkür ederim, misafirim vardı, bakamamıştım, kusuruma bakmayın,

Sayenizde bu problem de çözüldü, minnettarım.

Sağlıkla kalın, saygılarımla.

İyi günler dilerim.
.

Aktarma Makro'sunda Düzenleme (Seçime Göre)

1Al2Ver

Ömer BARAN

Uzman

1Al2Ver

Ömer BARAN

Uzman

1Al2Ver

Ömer BARAN

Uzman

1Al2Ver

1Al2Ver

Ömer BARAN

Uzman

1Al2Ver

Ömer BARAN

Uzman