formülü hızlandırmak için...

[turk4545]

arkadaşlar mrb.2 değişkenli sayma için kullandığım kod...

Sub say()
Range("c2").Clear
[d2].Clear
For a = 1 To 5000
For b = Date - 365 To Date
If Cells(a, 1) = b And Cells(a, 2) = "Erkek" Then
Range("c2").Value = [c2] + 1
Else
End If
If Cells(a, 1) = b And Cells(a, 2) = "Kadın" Then
Range("d2").Value = [d2] + 1
Else
End If
Next
Next
End Sub



ancak satır sayısı arttıkça çok yavaşlıyor.ve for b = tarihleri değiştikçe yani zaman aralığı arttıkça dahada yavaşlıyor. formül olarak topla.çarpım ile yaptım ancak topla.çarpım ile ilgili pek kod bulamadım.yardımcı olursanız sevinirim...

 

[turk4545]

sanırım ilgilenecek birileri çıkmayacak

 

[uzmanamele]

merhaba
kod çalışıyorsa yinede iyidir
5000*365=1.825.000 tur atıyor.
hayırdır ne arıyorsunuz bu şekilde? topla.çarpım veya düşeyara işinizi görmüyor mu?

 

[turk4545]

görüyor ama ondada şu sorun var.sayfayı her açtığımda sürekli formül hesaplama yapıyor ve sayfa donuyor yine dk kadar bekliyorum.biraz daha hızlı hesaplama olursa daha iyi olacak..

 

[turk4545]

bu arada topla.çarpım ile.... =TOPLA.ÇARPIM((A1:A5000<=BUGÜN())*(B1:B5000="Erkek"))-TOPLA.ÇARPIM((A1:A5000<=BUGÜN()-365)*(B1:B5000="Erkek"))

şeklinde..

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub BUL_SAY()
    Dim Tarih As Date, Bul As Range, Adres As String
    Dim Say_Erkek As Long, Say_Kadın As Long
    Application.ScreenUpdating = False
    [C2:D2].ClearContents
    For Tarih = (Date - 365) To Date
    Set Bul = [A:A].Find(Tarih, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Bul Is Nothing Then
    Adres = Bul.Address
    Do
    If Cells(Bul.Row, 2) = "Erkek" Then Say_Erkek = Say_Erkek + 1
    If Cells(Bul.Row, 2) = "Kadın" Then Say_Kadın = Say_Kadın + 1
    Set Bul = [A:A].FindNext(Bul)
    Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    Next
    [C2] = Say_Erkek
    [D2] = Say_Kadın
    Set Bul = Nothing
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[turk4545]

teşekkürler elinize sağlık