ÇOKETOPLA Ölçütü Hücreden Alma

[schlecht]

=ÇOKETOPLA(B2:B100;A2:A100;"*iSTANBUL*";C2:C100;"*KİTAP*")

*KİTAP* ölçüyünü hücreden aldırmaya çalıştım başaramadım. Yardımlarınızı rica ederim.

İyi günler.

 

[Korhan Ayhan]

Deneyiniz.

=ÇOKETOPLA(B2:B100;A2:A100;"*iSTANBUL*";C2:C100;"*" & A1 & "*")

 

[schlecht]

Korhan Hocam teşekkürler. Denedim tam istediğim gibi.

 

[KARTAL133]

Merhaba

Sayfa2 bulunan değerleri firma adı ve döviz cinisini (sabit kalacak) yazdığım zaman rakamları otomatik olarak gelmesini istiyorum. ayrıca mail adresini otomatik olarak gelmesini istiyorum.

Örnek tablo ektedir. yardımlarınızı için teşekkürler

 

[YUSUF44]

Hangi sayfada ne yaptığınızda hangi sayfada ne olmasını istiyorsunuz?

 

[KARTAL133]

Data Sayfa2 de raporu sayfa3 gelmesini ve mail adresilerin sayfa3 firma adına göre gelmesini istiyorum
Firma adını yazdığımda otomatik olarak veriler gelecek

 

[YUSUF44]

Aşağıdaki kodları Sayfa3'ün kod bölümüne yapıştırıp deneyiniz. Bu sayfada A3:A1000 aralığına veri girdiğinizde işlem yapar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A3:A1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then
    Target.Offset(0, 1) = ""
    Target.Offset(0, 2) = ""
    Target.Offset(0, 3) = ""
    Target.Offset(0, 4) = ""
    Target.Offset(0, 5) = ""
Else
    Set s1 = Sheets("Mail")
    Set s2 = Sheets("Sayfa2")
    son1 = s1.Cells(Rows.Count, "A").End(3).Row
    son2 = s2.Cells(Rows.Count, "A").End(3).Row
    If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), Target) = 0 Then
        MsgBox Target & " adlı firma Sayfa2'de bulunmuyor"
    Else
        Target.Offset(0, 1) = WorksheetFunction.SumIfs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
            s2.Range("B1:B" & son2), [B2])
        Target.Offset(0, 2) = WorksheetFunction.SumIfs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
            s2.Range("B1:B" & son2), [C2])
        Target.Offset(0, 3) = WorksheetFunction.SumIfs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
            s2.Range("B1:B" & son2), [D2])
        Target.Offset(0, 4) = WorksheetFunction.SumIfs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
            s2.Range("B1:B" & son2), [E2])
        If WorksheetFunction.CountIf(s1.Range("A1:A" & son1), Target) > 0 Then
            Target.Offset(0, 5) = WorksheetFunction.VLookup(Target, s1.Range("A1:B" & son1), 2, 0)
        End If
        If Target.Offset(0, 5) = "" Then
            Target.Offset(0, 5) = "Mail adresi giriniz"
        End If
    End If
End If
End Sub

 

[KARTAL133]

Merhaba

Desteğinizi için çok teşekkürler

 

[KARTAL133]

Merhaba

Sayfa2 nin D Sütünda "Yes" "No" Var toplamları "No göre nasıl bir makro eklene bilir. ?

 

[YUSUF44]

Dosyanızı isteğinize göre güncelleyip daha açık sorar mısınız?

 

[KARTAL133]

makroya ek olarak No ve Yes Ekledim.
Sayfa2 Toplamı "No" Göre Sayfa2 gelmesi
ve düşeyara ile sayfa2 deki "no" veya "yes" gelmesini istiyorum


Yardımınızı için teşekkürler.

 

[YUSUF44]

Kodda son2 yazmanız gerekirken son1 yazmışsınız.

Target.Offset(0, 5) = WorksheetFunction.VLookup(Target, s2.Range("A1:AG" & son2), 4, 0)

 

[KARTAL133]

Evet onu fark ettim.
ama mail adresi boş olduğunda hata alıyorum.

 

[YUSUF44]

Yazdığımız kodlarla çalıştırdığınız kodlar aynı değil. Kodları uyarlarken hata yapıyorsunuz muhtemelen. Bunun yerine örnek dosyanızı asıl dosyanızla "aynı yapıda" yapsaydınız sorun olmazdı.

Ekran görüntüsündeki hata aranan verinin aranılan yerde bulunmadığı zaman çıkar. Benim verdiğim kod bunu engellemek için kod varsa düşeyara yapıyordu. Siz uyarlarken bunu bozmuşsunuz.

Kodunuzu verinin arandığı yere göre güncelleyin.

 

[KARTAL133]

Kodu Böyle değiştirdim

mail adresi yok ise hata veriyor

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A3:A1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 2) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 4) = ""
Target.Offset(0, 5) = ""
Target.Offset(0, 6) = ""
Else
Set s1 = Sheets("Mail")
Set s2 = Sheets("Sayfa2")
son1 = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row
If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), Target) = 0 Then
MsgBox Target & " adlı firma Sayfa2'de bulunmuyor"
Else
Target.Offset(0, 1) = WorksheetFunction.sumifs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
s2.Range("B1:B" & son2), [B2], s2.Range("d1:d" & son2), "No")
Target.Offset(0, 2) = WorksheetFunction.sumifs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
s2.Range("B1:B" & son2), [C2], s2.Range("d1:d" & son2), "No")
Target.Offset(0, 3) = WorksheetFunction.sumifs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
s2.Range("B1:B" & son2), [D2], s2.Range("d1:d" & son2), "No")
Target.Offset(0, 4) = WorksheetFunction.sumifs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
s2.Range("B1:B" & son2), [E2], s2.Range("d1:d" & son2), "No")

If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), Target) > 0 Then
Target.Offset(0, 5) = WorksheetFunction.VLookup(Target, s2.Range("A1:z" & son2), 4, 0)
If WorksheetFunction.CountIf(s1.Range("A1:A" & son1), Target) > 0 Then
Target.Offset(0, 6) = WorksheetFunction.VLookup(Target, s1.Range("A1:B" & son1), 2, 0)
End If
If Target.Offset(0, 6) = "" Then
Target.Offset(0, 6) = "Mail adresi giriniz"
End If
End If
End If
End If
End Sub

 

[YUSUF44]

Son gönderdiğiniz dosya son2 düzeltmesini yaptıktan sonra bende herhangi bir hata vermedi. Ayrıca Yes No için tekrar kontrol etmeye gerek olmadığından o kısımdaki if sorgusunu iptal ettim. Bir de mevcut verilerden birini değiştirdiğinizde eğer sayfa2'de yoksa diğer hücreleri boşaltmayı ekledim:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A3:A40000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then
    Target.Offset(0, 1) = ""
    Target.Offset(0, 2) = ""
    Target.Offset(0, 3) = ""
    Target.Offset(0, 4) = ""
    Target.Offset(0, 5) = ""
    Target.Offset(0, 6) = ""
Else
    Set s1 = Sheets("Mail")
    Set s2 = Sheets("Sayfa2")
    son1 = s1.Cells(Rows.Count, "A").End(3).Row
    son2 = s2.Cells(Rows.Count, "A").End(3).Row
    If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), Target) = 0 Then
        MsgBox Target & " adlı firma Sayfa2'de bulunmuyor"
        Target.Offset(0, 1) = ""
        Target.Offset(0, 2) = ""
        Target.Offset(0, 3) = ""
        Target.Offset(0, 4) = ""
        Target.Offset(0, 5) = ""
        Target.Offset(0, 6) = ""
    Else
        Target.Offset(0, 1) = WorksheetFunction.sumifs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
            s2.Range("B1:B" & son2), [B2])
        Target.Offset(0, 2) = WorksheetFunction.sumifs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
            s2.Range("B1:B" & son2), [C2])
        Target.Offset(0, 3) = WorksheetFunction.sumifs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
            s2.Range("B1:B" & son2), [D2])
        Target.Offset(0, 4) = WorksheetFunction.sumifs(s2.Range("C1:C" & son2), s2.Range("A1:A" & son2), Target, _
            s2.Range("B1:B" & son2), [E2])
        Target.Offset(0, 5) = WorksheetFunction.VLookup(Target, s2.Range("A1:AG" & son2), 4, 0)
        If WorksheetFunction.CountIf(s1.Range("A1:A" & son1), Target) > 0 Then
            Target.Offset(0, 6) = WorksheetFunction.VLookup(Target, s1.Range("A1:C" & son1), 2, 0)
        End If
        If Target.Offset(0, 6) = "" Then
            Target.Offset(0, 6) = "Mail adresi giriniz"
        End If
    End If
End If
End Sub

 

[KARTAL133]

İlginiz için çok teşekkürler.

 

[stier_22]

peki bu formülü tüm satırlara nasıl kopyalaya bilirim şuan bende de böyle bir sorun var ctrl+c veya hücre kenarından çektiğimde aynı verileri aşağı kopyalıyor forumda da sordum cevap alamadım?

 

[schlecht]

peki bu formülü tüm satırlara nasıl kopyalaya bilirim şuan bende de böyle bir sorun var ctrl+c veya hücre kenarından çektiğimde aynı verileri aşağı kopyalıyor forumda da sordum cevap alamadım?

Ben not defterinde çoğaltıp excele geri kopyaladım. Başka çözüm bulamadım.

 

[YUSUF44]

peki bu formülü tüm satırlara nasıl kopyalaya bilirim şuan bende de böyle bir sorun var ctrl+c veya hücre kenarından çektiğimde aynı verileri aşağı kopyalıyor forumda da sordum cevap alamadım?

Burda formül yok ki! İşlem makroyla yapılıyor. Hangi formülden bahsediyorsunuz?