TOPLA.ÇARPIM formülünü makro ile çözmek

[denfab76]

Merhaba,
Sayfa1 de F93 hücresinde TOPLA.ÇARPIM((B93=Sayfa6!B2:B13000)*(C93=Sayfa6!C2:C13000)*Sayfa6!D213000) formülü ile kosullu arama yapiyorum. F93 hücresinde formül yazdigi icin hücre degerini istege bagli degisemiyorum. Butonsuz bu islemi makro ile cözebilirmiyim. Yani B93 ve C93 hücre degerleri girilince F93 otomatik gelsin, gerekiyorsa degisiklik yapmak istiyorum. Tesekkürler.

Ornek.xlsx dosyasını indir - download

Ornek.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s5.dosya.tc

 

[Korhan Ayhan]

Merhaba,

Sayfa1 isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Aranan As String, Bulunan As Variant, Son_Hucre As Range, Formul As String
   
    If Intersect(Target, Range("B93:C93")) Is Nothing Then Exit Sub
    If Target.Cells.CountLarge > 1 Then Exit Sub
   
    If Cells(Target.Row, "B") <> "" And Cells(Target.Row, "C") <> "" Then
        Aranan = Cells(Target.Row, "B").Value & "|" & Cells(Target.Row, "C").Value
        Set Son_Hucre = Sheets("Sayfa6").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        Formul = "=INDEX(Sayfa6!D1:D1048576,MATCH(""" & Aranan & """,Sayfa6!B1:B1048576&""|""&Sayfa6!C1:C1048576,0))"
        If Not Son_Hucre Is Nothing Then
            Bulunan = Evaluate(Replace(Formul, 1048576, Son_Hucre.Row))
            If Not IsError(Bulunan) Then
                Cells(Target.Row, "F") = Bulunan
            Else
                Cells(Target.Row, "F") = ""
                MsgBox "Aradığınız veri bulunamadı!", vbCritical
            End If
        End If
    End If
End Sub

 

[denfab76]

Merhaba,

Hocam tam ümidimi kesmisken yetistiniz. Kodu Sayfa1 deki kod bölümününe uygulayinca If Not Son Is Nothing Then kisminda hata verdi. Yanlis bir sey mi yaptim acaba. Tesekkürler.

 

[Korhan Ayhan]

Düzelttim. Yeniden deneyiniz.

 

[denfab76]

Korhan Bey kod tam istedigim gibi calisti. Emeginize saglik, iyiki varsiniz. Tessekkür ederim.

 

[denfab76]

Konuya ek olarak aklima takilan bir konu var. Makrolarda Korhan hocamin makrosunda hücrelere ( B93 ve C93 ) kendim giris yaptigimda makro gayet güzel calisiyor. B93 hücresinde Düseyara(A1;Sayfa7!A1:B945;2) ve C93 hücresinde Düseyara(E1;Sayfa7!A1:C16;3) formüllerini kullanarak deger getiriyorum ama hücrede degerler görünmesine ragmen makro calismiyor. Benim sorum hücrelerde formül ile getirilen degerlerin ayni el ile yazilmis gibi aktiv olmasi icin Excel ayarlarinda bir degisiklik mi yapmam gerekiyor. Acilan liste olusturdugumda makro calisiyor.

 

[Korhan Ayhan]

Merhaba,

Uygulanan prosedürde hücreye elle veri girişi öngörülmüştür.

Formülle gelen değerler değiştiği zaman bunu excelin algılaması için Worksheet_Change olayı yerine aşağıdaki olayı kullanmak gerekir.

Option Explicit

Private Sub Worksheet_Calculate()
    Dim S1 As Worksheet, Aranan As String, Bulunan As Variant, Son As Long, Formul As String
    
    On Error GoTo 10
    
    Set S1 = Sheets("Sayfa6")
    
    If Range("B93").Value <> "" And Range("C93").Value <> "" Then
        Application.EnableEvents = False
        Aranan = Range("B93").Value & "|" & Range("C93").Value
        Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
        Formul = "=INDEX(" & S1.Name & "!D1:D1048576,MATCH(""" & Aranan & """," & S1.Name & "!B1:B1048576&""|""&" & S1.Name & "!C1:C1048576,0))"
        Bulunan = Evaluate(Replace(Formul, 1048576, Son))
        If Not IsError(Bulunan) Then
            Range("F93").Value = Bulunan
        Else
            Range("F93").Value = ""
            MsgBox "Aradığınız veri bulunamadı!", vbCritical
        End If
    End If
10
    Set S1 = Nothing
    Application.EnableEvents = True
End Sub

 

[denfab76]

Korhan hocam sizlerin sayesinde her gün bir seyler ögreniyoruz. Tekrar cok tesekkür ederim, saglicakla kalin.

 

[Korhan Ayhan]

Kod çalıştı mı?

Bir deneme yapayım dedim. Bende hata verdi. Bu sebeple biraz değişiklik yaptım. Son halini deneyiniz.

 

[denfab76]

Hata veren satiri yukarda vermis oldugunuz If Not Son_Hucre Is Nothing Then olarak degisince kod calisti.

 

[Korhan Ayhan]

#7 nolu mesajımda ki koddan bahsediyorum.

 

[denfab76]

Korhan Bey kod asagidaki gibi calisti.


Private Sub Worksheet_Calculate()
Dim Aranan As String, Bulunan As Variant, Son_Hucre As Range, Formul As String

If Range("B93").Value <> "" And Range("C93").Value <> "" Then
Aranan = Range("B93").Value & "|" & Range("C93").Value
Set Son_Hucre = Sheets("Sayfa6").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Formul = "=INDEX(Sayfa6!D11048576,MATCH(""" & Aranan & """,Sayfa6!B1:B1048576&""|""&Sayfa6!C1:C1048576,0))"
If Not Son_Hucre Is Nothing Then
Bulunan = Evaluate(Replace(Formul, 1048576, Son_Hucre.Row))
If Not IsError(Bulunan) Then
Range("F93").Value = Bulunan
Else
Range("F93").Value = ""
MsgBox "Aradiginiz veri bulunamadi!", vbCritical
End If
End If
End If
End Sub

 

[Korhan Ayhan]

Bende sıkıntı çıkardı. O sebeple yeniden düzenledim.

Neyse sizde çalıştıysa sorun yoktur.