Dizi formülünü makro ile uygulama

[kemal turan]

Merhaba,
Satır satısı fazla olduğundan dolayı makro oluşturarak elde ettiğim kodları döngü ile daha hızlı bir şekilde sayfada kullanmak istedim.
Aynı yöntemle elde ettiğim ve F sutununda çalışan COUNTIF formülü gibi kod G2 den başlayan dizi formülü son dolu satıra kadar gitmiyor.
hücredeki dizi formülüm;
{=EĞER(E2=F2;MİN(EĞER('ÖZET TABLO'!A:A=UNITELER!A2;'ÖZET TABLO'!D));0)}
İlk defa dizi formülüne ihtiyacım oldu.
Yardımlarınızı rica ediyorum.
Teşekkür ederim.

Sub TAKIMHESAPLA()
Set S1 = Sheets("UNITELER")
Set S2 = Sheets("ÖZET TABLO")
S1.Select
S1.[F2:F10000].ClearContents 'giren
son = S1.Cells(Rows.Count, "A").End(3).Row
With S1.Range("F2:F" & son) 'GİREN
.Formula = "=COUNTIF('ÖZET TABLO'!C[-5],RC[-5])"
.Value = .Value
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
S1.[G2:G10000].ClearContents 'giren
son = S1.Cells(Rows.Count, "A").End(3).Row
With S1.Range("G2:G" & son) 'GİREN
Range("G2").Select
Selection.FormulaArray = _
        "=IF(RC[-2]=RC[-1],MIN(IF('ÖZET TABLO'!C[-6]=UNITELER!RC[-6],'ÖZET TABLO'!C[-3])),0)"
Value = .Value
End With

End Sub

 

[Korhan Ayhan]

İnceleyiniz.

DİZİ formülü hücre adresini güncellemiyor

Merhaba Arkadaşlar, F1 hücresindeki formülü makro haline getirip aşağıdaki kod ile uyguluyorum. Formülü el ile kopyalayınca normal çalışıyor ama kod ile uygulayınca E1 değişmiyor ! Sub Makro1() Range("F1:F3").FormulaArray = "=MIN(IF(R2C1:R10C1=RC[-1],R2C2:R10C2))" End Sub

www.excel.web.tr

 

[Korhan Ayhan]

Ek olarak bu linkte konuyla ilgili size fikir verecektir.

Bütün Formüller Makroya Dönüştürülebilir mi?

Merhaba Hepimizin arşivinde kullandığı, uzun veya kısa, dizi olan veya normal olan birçok formül vardır. Hangi sütunda kullandığımız belli olan, ne için kullandığımızı bildiğimiz, yani bilinçli kullandığımız herhangi bir formülü, istediğimiz zaman, makroya dönüşterebilme imkanımız var mıdır...

www.excel.web.tr

 

[kemal turan]

Merhaba Korhan Hocam
Önerdiğiniz konularda anladığım seviyede aşağıdaki kod la istediğim sonucu aldım.

Sub takımhesapla()
Set s1 = Sheets("UNITELER")
s1.[G2:G2000].ClearContents
For i = 2 To s1.Cells(65536, "A").End(xlUp).Row
If s1.Cells(i, "e").Value = s1.Cells(i, "f").Value Then
s1.Cells(i, "g").FormulaArray = "=MIN(IF('ÖZET TABLO'!C[-6]=UNITELER!RC[-6],'ÖZET TABLO'!C[-3]))"
Value = Value
End If
Next i

End Sub

1500 satırda yaklaşık 2 , 3 dk. sürüyor. ayrıca formül olarak kalıyor.
Biz bu kodu "Application.WorksheetFunction.Min........" şeklinde bir kodla hızlı bir şekilde uyarlayabilirmiyiz.

 

[Korhan Ayhan]

İlk paylaştığım linke #5 nolu mesajımda "Makro1" isimli makroyu kendi dosyanıza uyarlayabilirsiniz.

 

[kemal turan]

Merhaba Korhan Hocam
aşağıdaki şekilde if satırındaki mantıkla 2 dk. da olan süre 1 saniyeye düştü.
Çok teşekkür ederim.

Sub takımhesapla()
Set s1 = Sheets("UNITELER")
s1.[G2:G2000].ClearContents
For i = 2 To s1.Cells(65536, "A").End(xlUp).Row
If s1.Cells(i, "e").Value > 0 And s1.Cells(i, "e").Value = s1.Cells(i, "f").Value Then
son = s1.Cells(Rows.Count, "A").End(3).Row
  With Range("g2")
  s1.Cells(i, "g").FormulaArray = "=MIN(IF('ÖZET TABLO'!C[-6]=UNITELER!RC[-6],'ÖZET TABLO'!C[-3]))"
 .Value = .Value
    End With
    Else
    s1.Cells(i, "g").Value = [0]
End If
Next i
End Sub

 

[Korhan Ayhan]

Kemal bey döngüye gerek yoktu.

 

[kemal turan]

Kodumuzdaki with döngüsüne mi hocam

 

[Korhan Ayhan]

For-Next döngüsüne gerek yoktu.

 

[kemal turan]

For Next Döngüsüz çalışmadı hocam.
Vakit ayırdığınız için teşekkür ederim

 

[Korhan Ayhan]

Aşağıdaki gibi olabilir.

Option Explicit

Sub Array_Formula()
    Dim S1 As Worksheet, Son As Long

    Set S1 = Sheets("UNITELER")

    S1.Range("G2:G" & S1.Rows.Count).ClearContents

    Son = S1.Cells(S1.Rows.Count, "A").End(3).Row

    With S1.Range("G2")
        .FormulaArray = "=IF(E2=F2,MIN(IF('ÖZET TABLO'!A:A=UNITELER!A2,'ÖZET TABLO'!D:D)),0)"
        .Resize(Son - 1).FillDown
        .Resize(Son - 1).Value = .Resize(Son - 1).Value
    End With

    Set S1 = Nothing
End Sub