Formülün Makroya dönüştürülmesi (dçarp ve devrik dönüşüm için)

Katılım
6 Mayıs 2014
Mesajlar
264
Excel Vers. ve Dili
office 365
Altın Üyelik Bitiş Tarihi
23-06-2021
Ekteki dosyanın Y1 sayfası L,M,N sütunlarındaki formüllerin makro kodlarına ihtiyacım var. Bazı kodları forumda bulup kendime uyarlayıp kullanabiliyorum ama bu örnekteki formülleri koda dönüştürmem imkansız. M,N sütunlarındaki formüller birbirine benzer. L sütunundaki formülün küçük bir kısmı M,N sütunlarındaki formülden farklı: Devrik dönüşüm kısmında ">=" ile ilgili kısım farklı.



Not:
1- Y1 sayfasındaki söz konusu kodu uyarlayıp Y2 sayfasındaki formüller için de kullanmak istiyorum. ( Y2 sayfasında Y1 sayfasından farklı olarak B:K sütunları arasında dört sayı kullanılmıştır.)
2- Makro kodlarını butona atamayıp sonuçları altıncı satırdan itibaren ilgili sütunlara yazdırmak istiyorum.
3- Eğer zahmet olmazsa Ç sayfası K sütunundaki formülü de koda dönüştürmenizi rica ediyorum.
 

Ekli dosyalar

Katılım
6 Mayıs 2014
Mesajlar
264
Excel Vers. ve Dili
office 365
Altın Üyelik Bitiş Tarihi
23-06-2021
Dosyayı sadeleştirdikten sonra tekrar yükledim. Y1 sayfası L sütunundaki formülü makro koduna dönüştürmeye çalışıyorum. Formülü https://www.excel.web.tr/threads/ayni-satirda-yer-alan-rakamlari-saymak.98399/ adresinden aldım. Ömer Bey'in hazırladığı bir formül. Ben sadece Ç sayfası K sütunu ile ilgili koşulu formüle ekledim. Vakit ayırabilecek arkadaşlara teşekkür ederim
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Bu şekilde deneyin.
Kod:
Sub Say()

    Dim Sc As Worksheet, j As Byte, i As Long
    Dim a As String, b As String, c As String, d As String
    
    Set Sc = Sheets("Ç")
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    
    Range("L6:N" & Rows.Count).ClearContents
    
    c = Sc.Range("K9:K64").Address(external:=True)
    d = Sc.Range("A9:J64").Address(external:=True)
    
    For j = 12 To 14 'L-N sütun arası
        For i = 6 To Cells(Rows.Count, "B").End(xlUp).Row
            a = Cells(i, "B").Resize(1, 10).Address
            b = Cells(5, j).Address
            Cells(i, j).FormulaArray = Evaluate("=SUM(--(IF(" & c & "<" & b & _
                ",MMULT(ISNUMBER(MATCH(" & d & "," & a & ",0))+0,TRANSPOSE(COLUMN(" & d & ")^0)))= " & b & "))")
        Next i
    Next j
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlAutomatic
    End With
    
End Sub
 
Katılım
6 Mayıs 2014
Mesajlar
264
Excel Vers. ve Dili
office 365
Altın Üyelik Bitiş Tarihi
23-06-2021
Ömer Bey helal olsun. Allah tuttuğunuzu altın etsin, çok teşekkür ediyorum.
 
Üst