Oldukça Çoklu Koşulu Olan İşlemler

[FallenPaladin]

-- Makro ile çözüm önerisine ilave:
Sanıyorum verdiğim son cevaptaki formülü, konu sayfasında 10 numaralı cevap ekindeki örnek belgeye göre;
M, N ve O sütunundaki değerler (X, Y, Z) için T sütununa uygulayabilirsiniz ya da
o belgede yer alan makroda For Each hcr In b.Range("A2:A" & sonsat).SpecialCells(xlCellTypeVisible) şeklindeki döngü içerisinde,
yer alan b.Cells(sat, "O") = b.Cells(hcr.Row, "C") satırından sonra b.Cells(sat, "T") = b.Cells(hcr.Row, "D") şeklinde bir satır ekleyerek olayı orada da bitirebilirsiniz.

-- Verdiğim formülde kullanılan TOPLA.ÇARPIM işlevini inceleyiniz, araştırınız.
Kısaca özetleyeyim.
Herbir koşul için, şu sütunda şuna, bu sütunda buna eşit olanlar (eşit olanlar için 1, olmayanlar için 0 değeri dönecektir)
tüm koşullar gerçekleştiğinde bulunan 1'lerın ÇARPIMI olan 1 ile formülün en sonundaki hedef alandaki değeri ÇARPTIĞINIZI düşünün.

İlk veri satırı için koşulların tümünün 1 olduğu satır 12'nci satır oluyor bu satırdaki işlem de 1 x 1 x 1 x 11,3723 = 11,3723 oluyor.
İlk veri için koşullardan en az bir tanesi 0 ise (12'nci satır dışındaki satırlar) sonuç sıfır dönüyor ve bununla da ilgili satırlardaki hedef değerin çarpımı da 0 oluyor.
Son çarpım sonuçlarının toplamı da istenilen değerdir.

Bu ÇARPIM değerlerini (ÇARPIM sonuçlarını) , formül uygulanan hücre seçiliyken,
formül çubuğunun solundaki f(x) düğmesine tıkladığınzda açılacak olan küçük ekranda görebilir ve olayı daha iyi anlayabilirsiniz.

Örneğin formüldeki son kısmı *($D$3:$D$23) yerine *(SATIR($D$3:$D$23)) olarak yazsaydık sonuç 12 (satır no) olacaktı.

İyi çalışmalar dilerim.
.

Çok teşekkür ederim...

 

[FallenPaladin]

Alternatif.

=ÇOKETOPLA($D$3:$D$23;$A$3:$A$23;$G3;$B$3:$B$23;$H3;$C$3:$C23;$I23)

Çok teşekkür ederim...

 

[FallenPaladin]

@Ömer BARAN hocam sizin formül bir yere kadar iyi gitti ama şimdi 259bin veri üzerinde çalıştırınca bazı verilerde tutarsız sonuç verdi. Yani olması gereken hücre karşılığı yerine 0 yazdı. Formülü ve baktığı sütunları kontrol ettim bir sıkıntı görünmüyor gibi ama neden sıfır döndürüyor sonucu anlamadım.

@Orion1 hocam sizin formülünüzde aynı şekilde yaptı denediğim zaman.

Saygılar

 

[Ömer BARAN]

Sonucun sıfır olması; kriterlerde (X, Y, Z değerleri ile arama alanı arasında) tam eşleşme olmadığı anlamına geliyor.
Yok eğer eşleşmenin olduğunu görüyorsanız ve sonuç 0 ise sorun, bu verilerin (kriter veya arama alanındaki veriler)
METİN/SAYI gibi farklı biçimlerde olması gibi bir sorundan kaynaklanıyordur.

Sorun yaşanan verilerden oluşan bir örnek veri bloku eklerseniz bakayım.
.

 

[FallenPaladin]

Hocam bir de çok fazla yavaşladı excel. Şimdi sıfır sonucunu verdiği yerlerde, verileri kontrol ettim örneğin; 10 yazıyorsa bunu elle düzeltince veri geldi. Sanırım küsurattan kaynaklı bulamadı bu değerleri. Çok teşekkürler. Yavaşlamaya bir çözüm bulamaz mıyız acaba?

Saygılarımla

 

[Ziynettin]

Verileriniz çok olduğundan formul kasma yapar. Makro kullanmanız daha uygun olur.

Private Sub CommandButton1_Click()
    son = Cells(Rows.Count, 1).End(3).Row
    a = Range("A3:D" & son).Value
    Set dic = CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            krt = a(i, 1) & a(i, 2) & a(i, 3)
            dic(krt) = a(i, 4)
        Next i
    son = Cells(Rows.Count, 7).End(3).Row
    a = Range("G3:I" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            krt = a(i, 1) & a(i, 2) & a(i, 3)
                If dic.exists(krt) Then
                b(i, 1) = dic(krt)
            Else
                b(i, 1) = "Bulunamadı"
            End If
        Next i
    [J3].Resize(UBound(a)) = b
    MsgBox "İşlem Bitti.", vbInformation
End Sub

 

[Ömer BARAN]

Bu konu sayfasındaki MAKRO çözümü hız sıkıntısını kaldırır.

Veriyi elle yazdığınızda veya yazılmış veri hücresinde F2=>ENTER işlemi yaptığınızda veri bulunuyorsa;
bu değerleri SAYI gibi görseniz de aslında METİN olan değerlerdir anlamına geliyor.
Bu sorun için veri alanı dışında bir hücreye 1 yazın ve 1 yazdığınız hücreyi kopyalayın,
ardından da veri alanının tümünü seçip ÖZEL YAPIŞTIR => ÇARP şeklinde işlem yapın.
Çünkü fark etmediğiniz (X, Y, Z değeriyle zaten eşleşmeyen başka veri satırlarında da benzer durumlar olabilir.
Sıkıntı sadece eşleşen X,Y,Z değerleri yazıldığında fark edilir.

 

[FallenPaladin]

Verileriniz çok olduğundan formul kasma yapar. Makro kullanmanız daha uygun olur.

Private Sub CommandButton1_Click()
    son = Cells(Rows.Count, 1).End(3).Row
    a = Range("A3:D" & son).Value
    Set dic = CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            krt = a(i, 1) & a(i, 2) & a(i, 3)
            dic(krt) = a(i, 4)
        Next i
    son = Cells(Rows.Count, 7).End(3).Row
    a = Range("G3:I" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            krt = a(i, 1) & a(i, 2) & a(i, 3)
                If dic.exists(krt) Then
                b(i, 1) = dic(krt)
            Else
                b(i, 1) = "Bulunamadı"
            End If
        Next i
    [J3].Resize(UBound(a)) = b
    MsgBox "İşlem Bitti.", vbInformation
End Sub

Çok çok teşekkür ederim, evet gerçekten kasma ve yavaşlama sıkıntısı direkt ortadan kalktı.

 

[FallenPaladin]

Bu konu sayfasındaki MAKRO çözümü hız sıkıntısını kaldırır.

Veriyi elle yazdığınızda veya yazılmış veri hücresinde F2=>ENTER işlemi yaptığınızda veri bulunuyorsa;
bu değerleri SAYI gibi görseniz de aslında METİN olan değerlerdir anlamına geliyor.
Bu sorun için veri alanı dışında bir hücreye 1 yazın ve 1 yazdığınız hücreyi kopyalayın,
ardından da veri alanının tümünü seçip ÖZEL YAPIŞTIR => ÇARP şeklinde işlem yapın.
Çünkü fark etmediğiniz (X, Y, Z değeriyle zaten eşleşmeyen başka veri satırlarında da benzer durumlar olabilir.
Sıkıntı sadece eşleşen X,Y,Z değerleri yazıldığında fark edilir.

Çok teşekkürler Ömer hocam...

 

[Asri]

Verileriniz çok olduğundan formul kasma yapar. Makro kullanmanız daha uygun olur.

@Ziynettin, koşul sağlanır mı bilemem ancak izninizle aşağıdaki şekilde bir düzenleme yaptım.

Önceki kod, bu şekilde koşul oluşur ise 3,11,41 ile 31,1,41 de aynı sonucu verecektir.
Araya "-" eklerek bu sorun giderilebilir.

Private Sub CommandButton1_Click()
    son = Cells(Rows.Count, 1).End(3).Row
    a = Range("A3:D" & son).Value
    Set dic = CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            krt = a(i, 1) & "-" & a(i, 2) & "-" & a(i, 3)
            dic(krt) = a(i, 4)
        Next i
    son = Cells(Rows.Count, 7).End(3).Row
    a = Range("G3:I" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            krt = a(i, 1) & "-" & a(i, 2) & "-" & a(i, 3)
                If dic.exists(krt) Then
                b(i, 1) = dic(krt)
            Else
                b(i, 1) = "Bulunamadı"
            End If
        Next i
    [J3].Resize(UBound(a)) = b
    MsgBox "İşlem Bitti.", vbInformation
End Sub

 

[FallenPaladin]

@Ziynettin, koşul sağlanır mı bilemem ancak izninizle aşağıdaki şekilde bir düzenleme yaptım.

Önceki kod, bu şekilde koşul oluşur ise 3,11,41 ile 31,1,41 de aynı sonucu verecektir.
Araya "-" eklerek bu sorun giderilebilir.

Private Sub CommandButton1_Click()
    son = Cells(Rows.Count, 1).End(3).Row
    a = Range("A3:D" & son).Value
    Set dic = CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            krt = a(i, 1) & "-" & a(i, 2) & "-" & a(i, 3)
            dic(krt) = a(i, 4)
        Next i
    son = Cells(Rows.Count, 7).End(3).Row
    a = Range("G3:I" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            krt = a(i, 1) & "-" & a(i, 2) & "-" & a(i, 3)
                If dic.exists(krt) Then
                b(i, 1) = dic(krt)
            Else
                b(i, 1) = "Bulunamadı"
            End If
        Next i
    [J3].Resize(UBound(a)) = b
    MsgBox "İşlem Bitti.", vbInformation
End Sub

@asri hocam çok teşekkürler.

 

[Ziynettin]

@Ziynettin, koşul sağlanır mı bilemem ancak izninizle aşağıdaki şekilde bir düzenleme yaptım.

Önceki kod, bu şekilde koşul oluşur ise 3,11,41 ile 31,1,41 de aynı sonucu verecektir.
Araya "-" eklerek bu sorun giderilebilir.

Sn. Asri Bey, |, #, *, /, vs kriterlere göre bu tür ayraç kullanarak olumlu sonuç alınıyor. Bazen gözden kaçabiliyor. Düzenleme için teşekkürler.

 

[FallenPaladin]

Değerli Hocalarım;

Hepinizin eline, yüreklerine sağlık. Buraya kadar getirip çok yardımcı oldunuz. Aşağıdaki resimdeki gibi ilave bir özellik yapabilir miyiz acaba? Yani bu özellik de olursa 1 günümü alan işlemlerden kurtulmuş olacağım. Resimde görüldüğü gibi ben sarı ile işaretli olarak göstermeye çalıştım.
Yani; M4 hücresine denk gelen bir yere bir buton daha konulsa, ben gerekli hesaplamaları yaptıktan sonra bu butona basınca O-P-Q4 hücrelerinde hesapladığım değerleri Simülasyon1 diyerek isim açsa ve karşısına yazsa (NOPQ5 hücreleri) ve her hesap yaptıktan sonra bu butona bastığımda altına simülasyon sayısını 1 arttırarak yazsa. Olabilir mi acaba?

Hocalarım bu arada düzenleme yapma ihtiyacı hissettim atlamış olabilirim. Her seferinde Koordinat Bul butonuna da basacağım tabi çünkü D sütunun yeni tenör değerleri olacak onları bulmam gerekiyor.
Şimdiden çok teşekkürler.

 

[FallenPaladin]

Merhabalar;

sanırım olamıyor bu özellik Her şey için tekrardan teşekkürler. Ellerinize sağlık.

Saygılar

 

[FallenPaladin]

Değerli Hocalarım;

Biraz flood gibi oldu mesajlarım alt alta olunca ama yeni başlık açmak istemedim. Yine önemli bir konuda yardımcı olabilirseniz çok sevinirim. Bir önceki makrolu dosyada G-H-I sütunlarındaki koordinatları ABC sütunlarındakileri ile karşılaştırıp, aynı olanlara karşılık gelen D sütunundaki değerleri alıp J sütununa getiriyordu.

Sormak istediğim bu GHI sütunlarındaki değerleri bulup aldıktan sonra ABC sütunlarındaki değerlerde GHI sütunlarındakilere karşılık gelmeyenlerin tümünün D sütunundaki Tenör değerlerini Sıfır yapsa olur mu?

Şimdiden teşekkürler.
Saygılar

 

[Ziynettin]

Soruyu tam olarak anlayamadım yinede aşağıdaki kodu deneyiniz.

Sub test()
    son = Cells(Rows.Count, 7).End(3).Row
    a = Range("G3:I" & son).Value
    Set dic = CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            krt = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)
            dic(krt) = dic(krt) + 1
        Next i
    son = Cells(Rows.Count, 1).End(3).Row
    a = Range("A3:D" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            krt = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)
                If dic(krt) > 0 Then
                b(i, 1) = a(i, 4)
            Else
                b(i, 1) = 0
            End If
        Next i
    [D3].Resize(UBound(a)) = b
    MsgBox "İşlem Bitti.", vbInformation
End Sub

 

[FallenPaladin]

Soruyu tam olarak anlayamadım yinede aşağıdaki kodu deneyiniz.

Sub test()
    son = Cells(Rows.Count, 7).End(3).Row
    a = Range("G3:I" & son).Value
    Set dic = CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            krt = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)
            dic(krt) = dic(krt) + 1
        Next i
    son = Cells(Rows.Count, 1).End(3).Row
    a = Range("A3:D" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            krt = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)
                If dic(krt) > 0 Then
                b(i, 1) = a(i, 4)
            Else
                b(i, 1) = 0
            End If
        Next i
    [D3].Resize(UBound(a)) = b
    MsgBox "İşlem Bitti.", vbInformation
End Sub

Hocam çok teşekkür ederim çalıştı ama işlemi ben biraz karıştırdım sanırım. Öncelikle ben tasarım programından aldığım koordinat ve değerleri ABCD sütunlarındaki yerlerine yapıştıracağım, sonra Koordinat Bul butonuna basacağım ve GHI sütunlarını ABCD ile karşılaştırıp, burada denk gelen Tenör değeri dediğimiz D sütunundaki denk gelen değerleri J sütununa atayacak. Dolayısı ile aynı dosya içerisinde sizin yazdığınız kodu yaparsam o zaman Koordinat Bul dediğimde olmayacak sanırım. Anlatırken aklımdakini tam ifade edemiyorum sanırım.

Şöyle yapsak, bu koordinat bul butonu ile çalışan dosyada yukarıdaki bulma işlemini yapsam. Sonra bunları ayrı bir excele alıp GHIJ sütunlarına karşılık gelen değerleri ABCD bulsa ve bu karşılık gelenler dışında kalan, D sütununda yer alan tenör değerlerini sıfır yapsa. Bu şekilde olur mu?

Bir de; şimdi farkettim ki, ben ABCD sütunlarına değerleri koyuyorum ve GHI sütunlarını arıyorum ama ilk Koordinat Bul dediktan sonra ABCD bulunan değerlerden bazılarını değiştirip tekrar Koordinat Bul dersem değerleri getirmiyor.

Biliyorum çok zahmet veriyorum ve mahcubum. Yardımcı olabilirseniz çok sevinirim. Eğer anlatımım yine zayıfsa bir video çekip koyabilirim istenenler ile ilgili.

Saygılarımla

 

[FallenPaladin]

@Ziynettin Hocam sanırım eski halindeki "Koordinat Bul" makrosu da tam değeri bulamıyor. Yani bakıyorum ABCD sütunlarına koyduğum değerlerden GHIJ sütunlarında olanı karşılaştırıyorum ve X:1 Y:25: Z:42 olan ve Tenörü:3,49164 olması gereken değer, J sütununda 1,0988 olarak görünüyor. Sanırım başka bir koordinattakini alıp koyuyor. Bunu çözebilir miyiz?

Not: Hocam düzenleme yaptım şimdi gönderide. Sorun şu şekilde, koordinat bulurken yukarıdaki örnekteki gibi X,Y,Z koordinatı sırasıyla 1 25 42 olan koordinata karşılık gelen tenör değerini yazması gerekirken 125 4 2 koordinatına denk geleni yazıyor.
Saygılarımla