• DİKKAT

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

::.. Vba KODA BİR BİLEN MÜDAHALESİ ..::

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,986
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Herkese merhabalar !...

Belgeye eklediğim ACEMİCE ( :) ) oluşturulmuş makro kodlar Ms.Excel'in klasik formülleri şeklinde.

Bu kodların biraz daha VBA koda benzer bir şekilde düzenlenmesi gerekiyor.

Belgenin aslında satır sayısı çok fazla olduğundan biraz yavaşlık ta yaşıyorum.

Hızlanmayı da sağlayacak ve bir bilenin elinden çıkmış yeni kod oluşturulabilirse çok memnun olurum.

İlgilenenlere teşekkürler.
 
Son düzenleme:
::.. Mevcut Kodlar AŞAĞIDAKİ GİBİDİR ..::

Sorunumun, kod oluşturmadan önceki hali için açılmış konu linki şöyle.

http://www.excel.web.tr/f48/birbirini-etkileyen-formulleri-koda-d-n-t-rme-t128061.html#post696400
Korhan Ayhan' Alıntı:
Merhaba,...Sayfa olaylarına kod yazılarak çözülebilir. Müsait olduğumda sorunuza bakabilirim. Sizde bu arada boş durmayın. Forumdaki sayfa olaylarına yazılmış kodları inceleyin. Belki kendinizde çözüm üretebilirsiniz.
Genişletmek için tıkla ...
Korhan Bey Merhabalar !...
Elimden geldiğince oradan buradan faydalanarak bir kod oluşturdum. Ama yukarıdaki konuya ses çıkmayınca, geldiğim bu aşama için yeni konu açtım.
Dolayısıyla yukarıda linkini verdiğim konu açığa düşmüş oldu.

Bu nedenle, yukarıdaki linkte yer alan konunun silinmesinde yarar var.

Açtığım bu konuda da görüntüleme sayısı 671 iken katkı yine sıfır maalesef.

Lütfen ! Bir bilenin müdahalesini bekliyorum.
Belgede mevcut kodlar aşağıdaki gibidir.
Kod: 
[B][FONT="Arial Black"]Sub Formuller()[/FONT][/B]
Dim i As Integer

Set s2 = Sheets("üretim2")
sonu2 = s2.Cells(Rows.Count, 2).End(3).Row
        Application.Calculation = xlManual

    For i = 3 To sonu2
        Range("E" & i).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""I""&SUMPRODUCT(MAX((RC[-1]=R2C4:R[-1]C[-1])*(ROW(R2C9:R[-1]C[4])))))),0,INDIRECT(""I""&SUMPRODUCT(MAX((RC[-1]=R2C4:R[-1]C[-1])*(ROW(R2C9:R[-1]C[4]))))))"
        Range("G" & i).FormulaR1C1 = "=IF(AND(RC[4]>RC[9],RC[4]>RC[-2]),RC[4]-RC[-2],0)"
        Range("H" & i).FormulaR1C1 = "=IF(AND(RC[8]>RC[3],RC[8]>RC[-3]),RC[8]-RC[-3],0)"
        Range("I" & i).FormulaR1C1 = "=RC[-4]+RC[-3]+RC[-2]+RC[-1]"
        Range("K" & i).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""N""&SUMPRODUCT(MAX((RC[-1]=R2C10:R[-1]C[-1])*(ROW(R2C14:R[-1]C[3])))))),0,INDIRECT(""N""&SUMPRODUCT(MAX((RC[-1]=R2C10:R[-1]C[-1])*(ROW(R2C14:R[-1]C[3]))))))"
        Range("M" & i).FormulaR1C1 = "=IF(RC[3]>RC[-1],RC[3]-RC[-1],0)"
        Range("N" & i).FormulaR1C1 = "=RC[-3]+RC[-2]+RC[-1]"
        Range("P" & i).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""R""&SUMPRODUCT(MAX((RC[-1]=R2C15:R[-1]C[-1])*(ROW(R2C18:R[-1]C[2])))))),0,INDIRECT(""R""&SUMPRODUCT(MAX((RC[-1]=R2C15:R[-1]C[-1])*(ROW(R2C18:R[-1]C[2]))))))"
        Range("R" & i).FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("S" & i).FormulaR1C1 = "=COUNTIF(R3C4:RC[-15],RC[-15])"
        Range("T" & i).FormulaR1C1 = "=COUNTIF(R3C10:RC[-10],RC[-10])"
        Range("U" & i).FormulaR1C1 = "=COUNTIF(R3C15:RC[-6],RC[-6])"
        Range("V" & i).FormulaR1C1 = "=IF(MAX(RC[-11],RC[-6])>RC[-17],MAX(RC[-11],RC[-6])-RC[-17],0)"
     Next i

        Application.Calculation = xlAutomatic

    s2.Range("A3:V" & sonu2).Value = s2.Range("A3:V" & sonu2).Value

[B][FONT="Arial Black"]End Sub[/FONT][/B]
Lütfen destek. İyi günler dilerim.
 
Son düzenleme:
Konu çözülmüş değildir.
Destek ricam devam etmektedir.
 
Kod: 
Sub Formuller()
Dim i As Integer

Set s2 = Sheets("üretim2")
sonu2 = s2.Cells(Rows.Count, 2).End(3).Row
        Application.Calculation = xlManual

    For i = 3 To sonu2
        Range("E" & i).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""I""&SUMPRODUCT(MAX((RC[-1]=R2C4:R[-1]C[-1])*(ROW(R2C9:R[-1]C[4])))))),0,INDIRECT(""I""&SUMPRODUCT(MAX((RC[-1]=R2C4:R[-1]C[-1])*(ROW(R2C9:R[-1]C[4]))))))"
        Range("G" & i).FormulaR1C1 = "=IF(AND(RC[4]>RC[9],RC[4]>RC[-2]),RC[4]-RC[-2],0)"
        Range("H" & i).FormulaR1C1 = "=IF(AND(RC[8]>RC[3],RC[8]>RC[-3]),RC[8]-RC[-3],0)"
        Range("I" & i).FormulaR1C1 = "=RC[-4]+RC[-3]+RC[-2]+RC[-1]"
        Range("K" & i).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""N""&SUMPRODUCT(MAX((RC[-1]=R2C10:R[-1]C[-1])*(ROW(R2C14:R[-1]C[3])))))),0,INDIRECT(""N""&SUMPRODUCT(MAX((RC[-1]=R2C10:R[-1]C[-1])*(ROW(R2C14:R[-1]C[3]))))))"
        Range("M" & i).FormulaR1C1 = "=IF(RC[3]>RC[-1],RC[3]-RC[-1],0)"
        Range("N" & i).FormulaR1C1 = "=RC[-3]+RC[-2]+RC[-1]"
        Range("P" & i).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""R""&SUMPRODUCT(MAX((RC[-1]=R2C15:R[-1]C[-1])*(ROW(R2C18:R[-1]C[2])))))),0,INDIRECT(""R""&SUMPRODUCT(MAX((RC[-1]=R2C15:R[-1]C[-1])*(ROW(R2C18:R[-1]C[2]))))))"
        Range("R" & i).FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("S" & i).FormulaR1C1 = "=COUNTIF(R3C4:RC[-15],RC[-15])"
        Range("T" & i).FormulaR1C1 = "=COUNTIF(R3C10:RC[-10],RC[-10])"
        Range("U" & i).FormulaR1C1 = "=COUNTIF(R3C15:RC[-6],RC[-6])"
        Range("V" & i).FormulaR1C1 = "=IF(MAX(RC[-11],RC[-6])>RC[-17],MAX(RC[-11],RC[-6])-RC[-17],0)"
     Next i

        Application.Calculation = xlAutomatic

  [B][COLOR="Red"]  's2.Range("A3:V" & sonu2).Value = s2.Range("A3:V" & sonu2).Value[/COLOR][/B]

End Sub

Bu şekilde deneyiniz, kodunuz çalışacaktır.
Kolay gelsin.
 
antonio' Alıntı:
Kod: 
Sub Formuller()
......................
End Sub
Bu şekilde deneyiniz, kodunuz çalışacaktır.
Genişletmek için tıkla ...

İlginiz için teşekkürler ancak benim konu açılışında eklediğim kodlar zaten çalışır durumdaydı. İhtiyacım çalışmayan kodu çalışır hale getirmek değildi.
Sizin iptal önerdiğiniz satır ile formülleri yok edip sadece formül sonuçlarını hücrelerde bırakıyorum, zira maksadım formüllerin kalmaması, formül sonuçlarının kalması yönündedir.
Bunu da tüm işlem ve hesaplamaları kodlar vasıtasıyla yapıp, excel belgesini hiç bir formül içermeyecek hale getirmek için yapıyorum ve bu husus da benim için önemli.

Benim konu açmaktaki maksadım; oluşturduğum kodların biraz profesyonel kodlar haline dönüştürülmesini sağlamak.
Zira bakıp görmüşsünüzdür, bendeki kodlar excelin yerleşik fonksiyonlarından ibaret, yani kodun yaptığı hücreye excel formülü yazıp hesaplamayı yaptıktan sonra sonuçları değer olarak hücrede bırakmaktan ibaret.

Ben böyle excel fonksiyonları yerine gerçek VBA kodlarının
kullanıldığı bir kod oluşturulması ricasıyla bu konuyu açtım.

Benim açımdan ihtiyaç devam ediyor.

İlgilenenlere teşekkürler.
 
sayın ömer.baran sakin olun, oturun çalışın ve her ne yapmak istiyorsanız forumda paylaşılmış bilgilerden yararlanarak gerçekleştirin. Yeterki siz araştırın ve bilginizi geliştirin. Bu forumda her konuda bilgi mevcut.
Başkalarına bağırırcasına kırmızı kalın ve büyütülmüş puntolarla yazmanız formda ki saygı ve edep kurallarıyla bağdaşmıyor. Umarım daha sakin ve seviyeli devam edersiniz.
Kolay gelsin.
 
antonio' Alıntı:
sayın ömer.baran sakin olun, oturun çalışın ve her ne yapmak istiyorsanız forumda paylaşılmış bilgilerden yararlanarak gerçekleştirin. Yeterki siz araştırın ve bilginizi geliştirin. Bu forumda her konuda bilgi mevcut.
Başkalarına bağırırcasına kırmızı kalın ve büyütülmüş puntolarla yazmanız formda ki saygı ve edep kurallarıyla bağdaşmıyor. Umarım daha sakin ve seviyeli devam edersiniz.
Kolay gelsin.
Genişletmek için tıkla ...

Sayın antonio !...

Benim mesaj yazarken vurgulama maksatlı olarak yazı rengi ve boyutuna ilişkin tarzımın, forum kurallarına aykırı olduğunu düşünüyorsanız şikayet edersiniz olur biter.

Kullandığınız isim ve yazdığınız cümleler en azından Türkçe konusundaki hassasiyetiniz ve ciddiyetiniz konusunda bir miktar fikir veriyor.

Açtığım konu hakkındaki çözüm önerinize bakınca da Excel bilginizin ne durumda olduğu anlaşılıyor.

Size; bir mesaj yazdığınızda, göndermeden önce önizleme yapmanızı öneririm.
Böylece ağzınızdan (klavyenizden) çıkanı kulağınız duymuş (kulağınız duymasa da gözleriniz görmüş) olur.

Yaşınız, eğitim seviyeniz, aldığınız aile terbiyesi nedir bilemiyorum ama, yazdıklarınızı göndermeden önce en az bir kez okumanızı salık veriyorum.

Sizi terbiye, nezaket ve forum kurallarına uygun davranmaya davet ediyorum. Forum kurallarının ilgili bölümü aşağıdaki gibidir.

Genel Forum Kuralları
Mesaj İçeriği:
- Forum'da ....... ananelere aykırı, küfürlü, ...... mesajlar göndermek ve forum ....... kullanıcılarını küçümser davranışlarda bulunmak, aynı şekilde, ....... forum katılımcısını yada ...... küçültücü veya hakaret edici yazılar kesinlikle yasaktır.
Genişletmek için tıkla ...

Açtığım konu hakkında bilginiz yeterli değilse ya da ilginizi çekmiyorsa, cevap yazmazsınız olur biter.

Açtığım konunun başlığını bir kez daha okumanızda yarar var.

" ::.. Vba KODA BİR BİLEN MÜDAHALESİ ..:: "

.
 
Son düzenleme:
Bu arada açtığım konu günceldir ve henüz bir çözüm önerisi almış değilim.
İlgilenecek arkadaşlara teşekkürler.
 
Aşağıdaki kodu deneyiniz.

"üretim2" isimli sayfanızın kod bölümüne uygulayınız.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    If Target.Row < 3 Then Exit Sub
    Son_Satir = Cells(Rows.Count, 1).End(3).Row
    If Son_Satir < 3 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Range("E3:E" & Son_Satir).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""I""&SUMPRODUCT(MAX((RC[-1]=R2C4:R[-1]C[-1])*(ROW(R2C9:R[-1]C[4])))))),0,INDIRECT(""I""&SUMPRODUCT(MAX((RC[-1]=R2C4:R[-1]C[-1])*(ROW(R2C9:R[-1]C[4]))))))"
    Range("G3:G" & Son_Satir).FormulaR1C1 = "=IF(AND(RC[4]>RC[9],RC[4]>RC[-2]),RC[4]-RC[-2],0)"
    Range("H3:H" & Son_Satir).FormulaR1C1 = "=IF(AND(RC[8]>RC[3],RC[8]>RC[-3]),RC[8]-RC[-3],0)"
    Range("I3:I" & Son_Satir).FormulaR1C1 = "=RC[-4]+RC[-3]+RC[-2]+RC[-1]"
    Range("K3:K" & Son_Satir).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""N""&SUMPRODUCT(MAX((RC[-1]=R2C10:R[-1]C[-1])*(ROW(R2C14:R[-1]C[3])))))),0,INDIRECT(""N""&SUMPRODUCT(MAX((RC[-1]=R2C10:R[-1]C[-1])*(ROW(R2C14:R[-1]C[3]))))))"
    Range("M3:M" & Son_Satir).FormulaR1C1 = "=IF(RC[3]>RC[-1],RC[3]-RC[-1],0)"
    Range("N3:N" & Son_Satir).FormulaR1C1 = "=RC[-3]+RC[-2]+RC[-1]"
    Range("P3:P" & Son_Satir).FormulaR1C1 = "=IF(ISERROR(INDIRECT(""R""&SUMPRODUCT(MAX((RC[-1]=R2C15:R[-1]C[-1])*(ROW(R2C18:R[-1]C[2])))))),0,INDIRECT(""R""&SUMPRODUCT(MAX((RC[-1]=R2C15:R[-1]C[-1])*(ROW(R2C18:R[-1]C[2]))))))"
    Range("R3:R" & Son_Satir).FormulaR1C1 = "=RC[-2]+RC[-1]"
    Range("S3:S" & Son_Satir).FormulaR1C1 = "=COUNTIF(R3C4:RC[-15],RC[-15])"
    Range("T3:T" & Son_Satir).FormulaR1C1 = "=COUNTIF(R3C10:RC[-10],RC[-10])"
    Range("U3:U" & Son_Satir).FormulaR1C1 = "=COUNTIF(R3C15:RC[-6],RC[-6])"
    Range("V3:V" & Son_Satir).FormulaR1C1 = "=IF(MAX(RC[-11],RC[-6])>RC[-17],MAX(RC[-11],RC[-6])-RC[-17],0)"
    Range("E3:E" & Son_Satir).Value = Range("E3:E" & Son_Satir).Value
    Range("G3:G" & Son_Satir).Value = Range("G3:G" & Son_Satir).Value
    Range("H3:H" & Son_Satir).Value = Range("H3:H" & Son_Satir).Value
    Range("I3:I" & Son_Satir).Value = Range("I3:I" & Son_Satir).Value
    Range("K3:K" & Son_Satir).Value = Range("K3:K" & Son_Satir).Value
    Range("M3:M" & Son_Satir).Value = Range("M3:M" & Son_Satir).Value
    Range("N3:N" & Son_Satir).Value = Range("N3:N" & Son_Satir).Value
    Range("P3:P" & Son_Satir).Value = Range("P3:P" & Son_Satir).Value
    Range("R3:V" & Son_Satir).Value = Range("R3:V" & Son_Satir).Value
    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst