• DİKKAT

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

Formülü Makro olarak yazmak

  • Konbuyu başlatan Konbuyu başlatan YASINT
  • Başlangıç tarihi Başlangıç tarihi
Katılım
22 Ekim 2005
Mesajlar
166
Excel Vers. ve Dili
Excel 2003 Tr
Merhaba arkadaşlar
Satır sayısı oldukça fazla olan listem için aşağıdaki fonksiyon yardımıyla listemi hazırlıyorum. Fakat fonksiyonda dosya aşırı şişme yapıyor. Bu durumu makro ile nasıl hallederim.

İşime yarayan formül :

=TOPLA.ÇARPIM((FATURALAR!C:C=A2)*(FATURALAR!D:D=B2)*(FATURALAR!E:E=C2);(FATURALAR!H:H))

Yardımlarınızı bekliyorum. Teşekkür ederim.
 
Beceremedim arkadaşlar yardım edebilir misiniz???
 
Dosya içindeki formülü makroyla nasıl uygulayabiliriz?açıklama dosya içindedir.ilginiz için şimdiden teşekkür ederim.
 

Ekli dosyalar

Selamlar,

Sn. kemalist size iki yöntem sunuyorum. İkinci yöntem daha hızlı çalışır.

1. Yöntem (Döngü ile)

Kod:
Option Explicit
 
Sub ORTALAMA_HESAPLA_1()
    Dim X As Long
    
    For X = 4 To 325
        Cells(X, "C") = WorksheetFunction.Average(Range("S" & X & ":W" & X))
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub


2. Yöntem (With-End With-Formula)

Kod:
Option Explicit
 
Sub ORTALAMA_HESAPLA_2()
    With Range("C4:C325")
        .Formula = "=AVERAGE(S4:W4)"
        .Value = .Value
    End With
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Selamlar,

Sn. YASINT,

Oldukça fazla satır var demişsiniz. Dosyanızda en fazla kaç satır oluyor.

Formülünüzde "C:C" şeklinde bir aralık tanımlamışsınız. 2007 versiyonda bu ifade 1048576 satır demektir. Eğer veri içeren satır sayınız bu kadar değilse bu aralığı kullanmanız dosyanızın şişmesine ve ağır hesaplamasına sebep olmaktadır. Bu aralığı daraltarak formülünüzü hızlandırabilirsiniz.

Bahsettiğim bu yöntemler size çözüm olmuyorsa formül yerine ÖZET TABLO kullanabilirsiniz. Buda çözüm olmuyorsa tablonuza benzer küçük bir örnek dosya eklerseniz makro ile çözüm hazırlanabilir.
 
sayın korhan ilk başta ilginiz için teşekkür ederim.vermiş olduğunuz her bir kodu ayrı ayrı sayfanın kod bölümüne kayıt ederek denedim fakat çalışmadı acaba nerede hata yaptım
benim istediğm butonsuz çalışması
 
Selamlar,

Sn. kemalist,

Benim mesajımda kodu sayfanın kod bölümüne uygulayın şeklinde bir ifade varmı?

Ayrıca sizin mesajınızda ben bu işlemi buton kullanmadan yapmak istiyorum şeklinde bir ifade varmı?

Bizler sizlerin düşüncelerini maalesef okuyamıyoruz. Sorularınızı lütfen NET sorun. İnanın cevaplarınızda bir o kadar net olacaktır.
 
kodu sayfanın kod bölümüne yazarak ve butonsuz olarak uygulamak istiyorum.
 
Selamlar,

Sn. kemalist aşağıdaki kodu denermisiniz.

Kod:
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [S4:W65536]) Is Nothing Then Exit Sub
    Cells(Target.Row, "C") = WorksheetFunction.Average(Range("S" & Target.Row & ":W" & Target.Row))
End Sub
 
C SÜTUNU İÇİN YAZDIĞINIZ MAKROYU DİĞER SÜTUNLAR İÇİNDE UYARLADIM.SORUNUM ŞU:1-S SÜTUNUNA VERİLER KOPYALA YAPIŞTIR YOLUYLA GELDİĞİ İÇİN ÇALIŞMIYOR.ANCAK SSÜTUNUNA ELLE GİRDİĞMDE ÇALIŞIYOR. 2,SORUM DAHA HIZLI ÇALIŞAMAZMI? İLGİNİZ İÇİN ŞİMDİDEN TEŞEKKÜR EDERİM. dosya ektedir
 

Ekli dosyalar

Selamlar,

Aşağıdaki şekilde kodu biraz daha hızlandırabiliriz.

Kod:
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [S4:IJ325]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
        If WorksheetFunction.CountA(Range("S" & Target.Row & ":W" & Target.Row)) > 0 Then
            Cells(Target.Row, "C") = WorksheetFunction.Average(Range("S" & Target.Row & ":W" & Target.Row))
        Else
            Cells(Target.Row, "C") = ""
        End If
        If WorksheetFunction.CountA(Range("S" & Target.Row & ":AM" & Target.Row)) > 0 Then
            Cells(Target.Row, "D") = WorksheetFunction.Average(Range("S" & Target.Row & ":AM" & Target.Row))
        Else
            Cells(Target.Row, "D") = ""
        End If
        If WorksheetFunction.CountA(Range("S" & Target.Row & ":BP" & Target.Row)) > 0 Then
            Cells(Target.Row, "E") = WorksheetFunction.Average(Range("S" & Target.Row & ":BP" & Target.Row))
        Else
            Cells(Target.Row, "E") = ""
        End If
        If WorksheetFunction.CountA(Range("S" & Target.Row & ":DN" & Target.Row)) > 0 Then
            Cells(Target.Row, "F") = WorksheetFunction.Average(Range("S" & Target.Row & ":DN" & Target.Row))
        Else
            Cells(Target.Row, "F") = ""
        End If
        If WorksheetFunction.CountA(Range("S" & Target.Row & ":II" & Target.Row)) > 0 Then
            Cells(Target.Row, "G") = WorksheetFunction.Average(Range("S" & Target.Row & ":II" & Target.Row))
        Else
            Cells(Target.Row, "G") = ""
        End If
    Application.ScreenUpdating = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Hücre As Range
    If Intersect(Target, [S4:IJ325]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    With Range("C4:C325")
        .Formula = "=AVERAGE(S4:W4)"
        .Value = .Value
    End With
    With Range("D4:D325")
        .Formula = "=AVERAGE(S4:AM4)"
        .Value = .Value
    End With
    With Range("E4:E325")
        .Formula = "=AVERAGE(S4:BP4)"
        .Value = .Value
    End With
    With Range("F4:F325")
        .Formula = "=AVERAGE(S4:DN4)"
        .Value = .Value
    End With
    With Range("G4:G325")
        .Formula = "=AVERAGE(S4:II4)"
        .Value = .Value
    End With
    Application.ScreenUpdating = True
End Sub
 
Sayın korhan 2,sorun çözüldü fakat 1,hala devam ediyor
 
Selamlar,

Üstteki mesajımda bir ekleme yaptım. Kopyala-yapıştır ile "S" sütununa başka sütundaki verileri yapıştırdığımda sütundaki tüm satırların ortalaması alındı.
 
Merhaba korhan bey; kopyala yapıştırla ortalamalar alınıyor fakat s sütununa başka yerden bağla veri geldiğnde değişiklik olmuyor.
 
Selamlar,

Sn. kemalist,

Sorunuzu çözümlememiz için bize kendi çalışmanız konusunda detaylı bilgiler vermeniz gerekiyor. Daha önceki mesajlarınızda kopyala-yapıştır demiştiniz. Son mesajınızda ise başka yerden bağla veriler geliyor diyorsunuz.

Bağla derken "S" sütununda formüllermi var?
Bu sütuna bilgiler bu şekildemi geliyor?

Kod:
='Başka_Sayfa'!A1
 
Hocam işlem tamam yanlış terim kullanmışım özür dilerim.ilginize teşekkür ederim.
 
Teşekkür ederim.

Selamlar,

Sn. YASINT,

Oldukça fazla satır var demişsiniz. Dosyanızda en fazla kaç satır oluyor.

Formülünüzde "C:C" şeklinde bir aralık tanımlamışsınız. 2007 versiyonda bu ifade 1048576 satır demektir. Eğer veri içeren satır sayınız bu kadar değilse bu aralığı kullanmanız dosyanızın şişmesine ve ağır hesaplamasına sebep olmaktadır. Bu aralığı daraltarak formülünüzü hızlandırabilirsiniz.

Bahsettiğim bu yöntemler size çözüm olmuyorsa formül yerine ÖZET TABLO kullanabilirsiniz. Buda çözüm olmuyorsa tablonuza benzer küçük bir örnek dosya eklerseniz makro ile çözüm hazırlanabilir.

Bayağı geç oldu ama kusuruma bakmayın. Gerçekten çok teşekkür ederim. Şimdi gördüm mesajınızı ve dediğinizi yaptım oldu.. Sağolun
 
Geri
Üst