• DİKKAT

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

Formülleri Macro Yardımıyla Kurmak

Katılım
17 Aralık 2012
Mesajlar
133
Excel Vers. ve Dili
Microsoft 365
Slmlar,

Bu sitede Çok değerli Üstadların olduğunu bilerek bu soruyu gönül rahatlığıyla soruyorum. Çok çabuk çözüm sunuyorsunuz. Bu sebeple de ALTIN ÜYELİK ALDIM. İlk Kez Bİr siteye ücret ödedim...

Ben temel olarak minimum 200.000 maksimum 600.000satırlı verilerle çalışıyorum. Excel temel prensiplerini biliyor gibiyim. Bunlardan biriside satırlara yazılan formül çoğaldıkça excel baytı büyüyor ve hareket etmek zorlaşıyor. Benim en çok kullandığım formüller: EĞERSAY,ETOPLA,ÇOKETOPLA,DÜŞEYARA formülleri veya PİVOTTABLE. Bu förmülleri 100satırlı bir hücre içeren verilere kurup kopyalamak gayet olanaklı. Ama 300.000 satırlı bir datada 1.satırda kurup 300bininci satıra kadar aşağı kopyaladığında işler zorlaşıyor. exceli kasıyor.. Ve sonrasında filtre edip çalışmak veya o sayfada herhangi bir işlem yapmak imkansız hale geliyor.

İşte bunu için bir macro kurabilir miyiz. Ekli dosyada SUMİFS formüllü bir tablom var. SUMİFS için örnek olarak siz kod yazarsanız ben tüm formüllerde değiştirip uygularım gibi geliyor. Yani formül hücre içinde kaldığı sürece excel ağırlaşacak, oysa arka planda formülü macroyla kod olarak hazırlar, bir butonla çalıştırırsak sadece sonuçları hücreye atarsak sorun olmaz gibi geliyor. Bu arada EKDEKİ DOSYA 9 SATIRLI ama siz onu 1.sütunu baz alarak aktif satır olarak yaparsanız sevinirim çünkü ben 300-400bin satırlı excelde uygulayacağım bazen..

Şimdiden teşekkürler

DOSYA EKTEDİR.
 

Ekli dosyalar

Son düzenleme:
Aşağıdaki kodu deneyin.
Kod:
Sub FormülüYaz()
Dim ws1 As Worksheet: Set ws1 = Sheets("ÖZET")
Dim sonsatır As Long: sonsatır = ws1.Range("A1000000").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ws1.Range("D2:E" & sonsatır)
.ClearContents
End With
With ws1.Range("D2:D" & sonsatır)
.Formula = "=SUMIFS(DATA!F:F,DATA!E:E,ÖZET!C2,DATA!C:C,ÖZET!B2,DATA!A:A,ÖZET!A2)"
.Value = .Value
End With
With ws1.Range("E2:E" & sonsatır)
.Formula = "=SUMIFS(DATA!G:G,DATA!E:E,ÖZET!C2,DATA!C:C,ÖZET!B2,DATA!A:A,ÖZET!A2)"
.Value = .Value
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Merhaba.

Aşağıdaki gibi olabilir.

Aşağıdaki kod'da;
►mavi kısımla formül uygulayarak sonuç elde edilir,
mavi kısımdaki .Value=.Value satırının sol başına ' (TEK TIRNAK) eklerseniz formül olarak kalır, eklemezseniz formül sonuçları değer olarak hücrelere yazılır.
kırmızı kısımda ise hücrelere tek tek formül sonuçları (sayfaya formül uygulanmadan) değer olarak yazılır.

Tercihinize göre; sadece kırmızı kısmı veya sadece mavi kısmı kullanın, diğerini silin.
.
Kod:
[B]Sub SUMIFS_UYGULA()[/B]

Set d = Sheets("DATA"): Set o = Sheets("ÖZET")
o.Range("D2:E" & Rows.Count).ClearContents
ds = d.Cells(Rows.Count, 1).End(3).Row: oson = o.Cells(Rows.Count, 1).End(3).Row
o.Range("D2:E" & oson).NumberFormat = "#,##0.00 ;[Red]-#,##0.00 "

[COLOR="Blue"]With o.Range("[B]D[/B]2:[B]E[/B]" & oson)
    .Formula = "=SUMIFS(DATA!F2:F" & ds & ",DATA!$E2:$E" & ds & ",ÖZET!$C2,DATA!$C2:$C" & ds & ",ÖZET!$B2,DATA!$A2:$A" & ds & ",ÖZET!$A2)"
[COLOR="Black"][B]    .Value = .Value[/B][/COLOR]
End With[/COLOR]
    
    
[COLOR="Red"]For brn = 2 To o.Cells(Rows.Count, 1).End(3).Row
    o.Cells(brn, "D") = Evaluate("=SUMIFS(DATA!F2:F" & ds & ",DATA!E2:E" & ds & ",ÖZET!C" & brn & _
                     ",DATA!C2:C" & ds & ",ÖZET!B" & brn & ",DATA!A2:A" & ds & ",ÖZET!A" & brn & ")")
    o.Cells(brn, "E") = Evaluate("=SUMIFS(DATA!G2:G" & ds & ",DATA!E2:E" & ds & ",ÖZET!C" & brn & _
                     ",DATA!C2:C" & ds & ",ÖZET!B" & brn & ",DATA!A2:A" & ds & ",ÖZET!A" & brn & ")")
Next[/COLOR]

[B]End Sub[/B]

SONRADAN İLAVE NOT: Sayın turist benden önce davranmış.
.
 
Aşağıdaki kodu deneyin.
Kod:
Sub FormülüYaz()
Dim ws1 As Worksheet: Set ws1 = Sheets("ÖZET")
Dim sonsatır As Long: sonsatır = ws1.Range("A1000000").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ws1.Range("D2:E" & sonsatır)
.ClearContents
End With
With ws1.Range("D2:D" & sonsatır)
.Formula = "=SUMIFS(DATA!F:F,DATA!E:E,ÖZET!C2,DATA!C:C,ÖZET!B2,DATA!A:A,ÖZET!A2)"
.Value = .Value
End With
With ws1.Range("E2:E" & sonsatır)
.Formula = "=SUMIFS(DATA!G:G,DATA!E:E,ÖZET!C2,DATA!C:C,ÖZET!B2,DATA!A:A,ÖZET!A2)"
.Value = .Value
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Sayın @Turist Harikasınız..

Elinize sağlık, çok kullanışlı bir kod yazmışsınız. Kullandım, Çok Teşekkürler ederim
 
Merhaba.

Aşağıdaki gibi olabilir.

Aşağıdaki kod'da;
►mavi kısımla formül uygulayarak sonuç elde edilir,
mavi kısımdaki .Value=.Value satırının sol başına ' (TEK TIRNAK) eklerseniz formül olarak kalır, eklemezseniz formül sonuçları değer olarak hücrelere yazılır.
kırmızı kısımda ise hücrelere tek tek formül sonuçları (sayfaya formül uygulanmadan) değer olarak yazılır.

Tercihinize göre; sadece kırmızı kısmı veya sadece mavi kısmı kullanın, diğerini silin.
.
Kod:
[B]Sub SUMIFS_UYGULA()[/B]

Set d = Sheets("DATA"): Set o = Sheets("ÖZET")
o.Range("D2:E" & Rows.Count).ClearContents
ds = d.Cells(Rows.Count, 1).End(3).Row: oson = o.Cells(Rows.Count, 1).End(3).Row
o.Range("D2:E" & oson).NumberFormat = "#,##0.00 ;[Red]-#,##0.00 "

[COLOR="Blue"]With o.Range("[B]D[/B]2:[B]E[/B]" & oson)
    .Formula = "=SUMIFS(DATA!F2:F" & ds & ",DATA!$E2:$E" & ds & ",ÖZET!$C2,DATA!$C2:$C" & ds & ",ÖZET!$B2,DATA!$A2:$A" & ds & ",ÖZET!$A2)"
[COLOR="Black"][B]    .Value = .Value[/B][/COLOR]
End With[/COLOR]
    
    
[COLOR="Red"]For brn = 2 To o.Cells(Rows.Count, 1).End(3).Row
    o.Cells(brn, "D") = Evaluate("=SUMIFS(DATA!F2:F" & ds & ",DATA!E2:E" & ds & ",ÖZET!C" & brn & _
                     ",DATA!C2:C" & ds & ",ÖZET!B" & brn & ",DATA!A2:A" & ds & ",ÖZET!A" & brn & ")")
    o.Cells(brn, "E") = Evaluate("=SUMIFS(DATA!G2:G" & ds & ",DATA!E2:E" & ds & ",ÖZET!C" & brn & _
                     ",DATA!C2:C" & ds & ",ÖZET!B" & brn & ",DATA!A2:A" & ds & ",ÖZET!A" & brn & ")")
Next[/COLOR]

[B]End Sub[/B]

SONRADAN İLAVE NOT: Sayın turist benden önce davranmış.
.

Ömer bey ilginiz için teşekküler. Kullanış olarak her formüle uyarlayabileceğim bir kod yazmış sayın turist.. İginiz için teşekkürler
 
Son düzenleme:
Geri
Üst