• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

S

schlecht

Katılım
13 Kasım 2009
Mesajlar
337
Excel Vers. ve Dili
Ofis 2016 TR 64 Bit
=Ç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.
 
Deneyiniz.

Kod: 
=ÇOKETOPLA(B2:B100;A2:A100;"*iSTANBUL*";C2:C100;"*" & A1 & "*")
 
Korhan Hocam teşekkürler. Denedim tam istediğim gibi.
 
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
 

Ekli dosyalar

Hangi sayfada ne yaptığınızda hangi sayfada ne olmasını istiyorsunuz?
 
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
 
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:

Kod: 
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
 
Merhaba

Sayfa2 nin D Sütünda "Yes" "No" Var toplamları "No göre nasıl bir makro eklene bilir. ?
 
Dosyanızı isteğinize göre güncelleyip daha açık sorar mısınız?
 
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.
 

Ekli dosyalar

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

Rich (BB code): 
Target.Offset(0, 5) = WorksheetFunction.VLookup(Target, s2.Range("A1:AG" & son2), 4, 0)
 
Evet onu fark ettim.
ama mail adresi boş olduğunda hata alıyorum.
 

Ekli dosyalar

  • hata.PNG
    hata.PNG
    40.6 KB · Görüntüleme: 2
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.
 
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
 
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:

PHP: 
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
 
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?
 
stier_22' Alıntı:
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?
Genişletmek için tıkla ...
Ben not defterinde çoğaltıp excele geri kopyaladım. Başka çözüm bulamadım.
 
stier_22' Alıntı:
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?
Genişletmek için tıkla ...
Burda formül yok ki! İşlem makroyla yapılıyor. Hangi formülden bahsediyorsunuz?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst