• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aktar Makrosunda Düzenleme

1Al2Ver

1Al2Ver

Katılım
5 Kasım 2007
Mesajlar
4,727
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Merhabalar,

"Rapor" sayfasında Malzeme_Çıkışına Aktar isimli bir kod var, ancak ben "Rapor" sayfasında "H" sütunundaki yemekleri "I" kaydırınca, doğal olarak ta kod yanlış aktarımda bulunuyor,

Bir iki deneme yaptım ama maalesef yine sonuç elde edemedim,

Yardım rica ediyorum.

Teşekkür ederim.

NOT ; Dosya 3 nolu mesajda yenilenmiştir.
 
Son düzenleme:
Merhaba Arkadaş,
Ne olması gerekiyordu dosyanızda?
 
Merhaba.

Başlarığım işe devam edeyim.
Mevcut kodu aşağıdaki ile değiştirmeniz yeterli olur.
.
Kod: 
[FONT="Arial Narrow"][B][COLOR="blue"]Sub MENÜ_LİSTELE()[/B][/COLOR]
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)
        
[COLOR="Blue"]        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[/COLOR]

        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"
[B][COLOR="blue"]End Sub[/COLOR][/B]

[B][COLOR="blue"]Sub Malzeme_Çıkışına_Aktar()[/COLOR][/B]
Set s2 = Sheets("RAPOR"): Set s3 = Sheets("Malzeme_Çıkışı")
ilksatır = 17: sonsatır = s2.[D[B][COLOR="red"]60[/COLOR][/B]].End(3).Row: tarih = s2.[H1]
For satır = ilksatır To sonsatır
s3satır = s3.[A[B][COLOR="red"]65536[/COLOR][/B]].End(3).Row + 1
    s3.Cells(s3satır, 1) = tarih: s3.Cells(s3satır, 2) = s2.Cells(satır, 2)
    s3.Cells(s3satır, 3) = s2.Cells(satır, 3): s3.Cells(s3satır, 4) = s2.Cells(satır, 4)
    s3.Cells(s3satır, 5) = s2.Cells(satır, 6): s3.Cells(s3satır, 6) = s2.Cells(satır, 8)
Next
s2.Range("A17:I[B][COLOR="red"]59[/COLOR][/B]").ClearContents
MsgBox "İşlem TAMAM.", vbInformation
[B][COLOR="Blue"]End Sub[/COLOR][/B][/FONT]
 
Son düzenleme:
Ömer BARAN' Alıntı:
Merhaba.

Başlarığım işe devam edeyim.
Mevcut kodu aşağıdaki ile değiştirmeniz yeterli olur.
.
Kod: 
[FONT="Arial Narrow"][B][COLOR="blue"]Sub Malzeme_Çıkışına_Aktar()[/COLOR][/B]
Set s2 = Sheets("RAPOR"): Set s3 = Sheets("Malzeme_Çıkışı")
ilksatır = 17: sonsatır = s2.[D65536].End(3).Row: tarih = s2.[H1]
For satır = ilksatır To sonsatır
s3satır = s3.[A65536].End(3).Row + 1
    s3.Cells(s3satır, 1) = tarih: s3.Cells(s3satır, 2) = s2.Cells(satır, 2)
    s3.Cells(s3satır, 3) = s2.Cells(satır, 3): s3.Cells(s3satır, 4) = s2.Cells(satır, 4)
    s3.Cells(s3satır, 5) = s2.Cells(satır, 6): s3.Cells(s3satır, 6) = s2.Cells(satır, 8)
Next
s2.Range("A" & ilksatır & ":I" & sonsatır).Clear
MsgBox "İşlem TAMAM.", vbInformation
[B][COLOR="Blue"]End Sub[/COLOR][/B][/FONT]
Genişletmek için tıkla ...

Teşekkür ederim Ömer bey,

Çok oldum biliyorum, "Rapor" sayfasının 59 satırından sonra dip notlar ve farklı hesaplamalar var, söz etmeyi unutmuşum, özür dilerim,

Acaba aktarmayı A17:I59 arası yapıp ve bu aralığı aktarma sonrası silebilir miyiz ? Tabi toplam satırı da aktarılıyor, bu nedenle o satırı iptal etmeliyiz, H15 ve H16 ya aldıra biliriz,

Bu ayrıntılar için kusuruma bakmayın,

Tekrar teşekkür ederim.
 
Önceki cevabımda yer alan kod'da değişiklik yaptım,
hem REÇETE AKTARMA ve hem de MAMZEME SAYFASINA AKTARma kodlarında değişiklik gerekiyordu.
Her iki kodu önceki cevabımı tekrar kontrol ederek belgenizdeki eskieriyle değiştirin.
Her şey 60'ıncı satırında üstünde olup bitiyor.
REÇETE AKTAR işleminde 59'uncu satırı aşan veriniz olmayacağını düşünüyorsunuz anlaşılan.
.
 
Ömer BARAN' Alıntı:
Önceki cevabımda yer alan kod'da değişiklik yaptım,
hem REÇETE AKTARMA ve hem de MAMZEME SAYFASINA AKTARma kodlarında değişiklik gerekiyordu.
Her iki kodu önceki cevabımı tekrar kontrol ederek belgenizdeki eskieriyle değiştirin.
Her şey 60'ıncı satırında üstünde olup bitiyor.
REÇETE AKTAR işleminde 59'uncu satırı aşan veriniz olmayacağını düşünüyorsunuz anlaşılan.
.
Genişletmek için tıkla ...

Tekrar merhaba ve iyi sabahlar Ömer bey,

Yeni kodu uyguladım,

Bir iki küçük hatacık var, onuda gün içinde paylaşacağım,

Elinize sağlık, sevgiyle kalın.

Saygılarımla.
 
Ömer bey merhaba,

1) Malzemelerden birimleri "Gr" dışında kalan, "Ad.", "Demet", "Şişe" vb. olanları bölünmesiz yazmalı (0,114 yerine ; 114 gibi)

2) "Rapor" sayfasında, "H" sütunundaki maliyet hatalı, ben resimde doğrularını yazdım,

3) Olabiliyorsa (koşullu biçimlendirme de olabilir) raporun örnekteki gibi çizgilendirilmesini arzuluyorum (resimde tablonun sol çizgisi çıkmamış)

4) Öğrenmek adına ; "Rapor" sayfasındaki çizelgede "H" sütunu aktarma esnasında boş gelse ve ben oraya formül yazsam ve çizelgeyi, "Malzeme_Çıkışı'na Aktar" dediğimde formüller silinmese, kodların neresinde bir düzenleme yapmak gerekir ?

Teşekkür ederim.

 
Tekrar merhaba.

4 numaralı cevaptaki kod'u (MENÜ LİSTELE kod'u) değiştirdim onu kullanabilirsiniz.
.
 
Merhabalar Ömer bey,

Öncelikle teşekkür ederim, sizi bir hayli yoruyorum, hakkınızı helal ediniz.

Yeni bir dosya oluşturup kodlarınızı ekledim, sorun kalmadı, orj.dosyaya uyarlayıp sonucu bildiririm.

Teşekkür ederim.

Saygılarımla.
 
Son düzenleme:
Merhabalar,

aşağıdaki kodda, kod mantığını öğrenmek adına bazı girişimlerim oldu,

Kırmızı H16 orj.de I16
Kırmızı 8'ler de orj.de 9

Orj.haldeyken A sütununa yemek adlarına sıra no.su veriyor,
Ben I16 yı, H16 ve 9 ları 8 yapınca sıra no.ları gelmedi.

Hangi satırı düzelmem gerekiyor ?

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.[[COLOR="Red"]h16[/COLOR]].End(3).Row
Cells(ra.[C60].End(3).Row + 1, 2) = ra.Cells(yemek, [COLOR="red"]8[/COLOR])
    ilk = WorksheetFunction.Match(ra.Cells(yemek, [COLOR="red"]8[/COLOR]), RE.Range("B:B"), 0)
    son = WorksheetFunction.CountIf(RE.Range("B:B"), ra.Cells(yemek, [COLOR="red"]8[/COLOR])) + 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
 
Şu an bilgisayar başında değilim (İstanbul' a avdet etmek üzere yoldayım).
A sütununa sıra numarası veren kısım kodun alt tarafında With ra.Range("A17:A" .... diye başlayan ve End With diye biten kısım ve basit bir formül, oradaki .Value şeklinde başlayan satırın sol başına TEK TIRNAK ekleyip kodu çalıştırırsanız formülü hücrede görebilirsiniz.
Bence kod ekranını açın ve F8 tuşuna tane tane basarak (bu sırada syfayı da görebileceğimiz şekilde konumlandırın) kodu adım adım çalıştırın.
Bu şekilde daha anlaşılır olacağını sanıyorum.
Eğer halledemezseniz gece geç vakit konuya bakarım.
.
 
Ömer BARAN' Alıntı:
Şu an bilgisayar başında değilim (İstanbul' a avdet etmek üzere yoldayım).
A sütununa sıra numarası veren kısım kodun alt tarafında With ra.Range("A17:A" .... diye başlayan ve End With diye biten kısım ve basit bir formül, oradaki .Value şeklinde başlayan satırın sol başına TEK TIRNAK ekleyip kodu çalıştırırsanız formülü hücrede görebilirsiniz.
Bence kod ekranını açın ve F8 tuşuna tane tane basarak (bu sırada syfayı da görebileceğimiz şekilde konumlandırın) kodu adım adım çalıştırın.
Bu şekilde daha anlaşılır olacağını sanıyorum.
Eğer halledemezseniz gece geç vakit konuya bakarım.
.
Genişletmek için tıkla ...

Merhaba Ömer bey,

İyi yolculuklar dilerim,

Yönlendirmeleriniz sonucu öğrendim, sağ olun.

Teşekkür ederim.
 
Merhaba,

Bu kod'un neresine ve nasıl bir komut eklemeliyim ki, tablodaki Brm (4.sütun) sütununda gr ifadesi geçen yerlere kg yazsın.(Reçete de oynama yapmayacağım ancak orada gr olanı kod kg olarak yazacak)

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

Sub Malzeme_Çıkışına_Aktar()
Set s2 = Sheets("RAPOR"): Set s3 = Sheets("Malzeme_Çıkışı")
ilksatır = 17: sonsatır = s2.[D60].End(3).Row: tarih = s2.[H1]
For satır = ilksatır To sonsatır
s3satır = s3.[A65536].End(3).Row + 1
    s3.Cells(s3satır, 1) = tarih: s3.Cells(s3satır, 2) = s2.Cells(satır, 2)
    s3.Cells(s3satır, 3) = s2.Cells(satır, 3): s3.Cells(s3satır, 4) = s2.Cells(satır, 4)
    s3.Cells(s3satır, 5) = s2.Cells(satır, 6): s3.Cells(s3satır, 6) = s2.Cells(satır, 8)
Next
s2.Range("A17:I59").ClearContents
MsgBox "İşlem TAMAM.", vbInformation
End Sub
 
Şöyle deneyin.:cool:
Kod: 
If Cells(rasat, 4) = "Gr" Then
    cells(rasat,4).value = "Kg"
 
Orion1' Alıntı:
Şöyle deneyin.:cool:
Kod: 
If Cells(rasat, 4) = "Gr" Then
    cells(rasat,4).value = "Kg"
Genişletmek için tıkla ...

Merhaba Sayın Orion1,

Öncelikle duyarlığınız için teşekkür ederim, küçük bir ricam daha olacak,

Önerdiğiniz kodu, ilgili kod grubunda hangi satıra ilave etmeliyim ?
 
1Al2Ver' Alıntı:
Merhaba Sayın Orion1,

Öncelikle duyarlığınız için teşekkür ederim, küçük bir ricam daha olacak,

Önerdiğiniz kodu, ilgili kod grubunda hangi satıra ilave etmeliyim ?
Genişletmek için tıkla ...

Gösterdiğim yere.:cool:
 
1Al2Ver' Alıntı:
Merhaba Sayın Orion1,

Next ile ilgi hata mesajı veriyor,

Teşekkür ederim.
Genişletmek için tıkla ...

Ekledikten sonraki kodların durumunu gösteren yerleri buraya yapıştırınız.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst