• DİKKAT

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

Süzülen Verilerin Başka Tabloda Toplamını Almak

  • Konbuyu başlatan Konbuyu başlatan 1Al2Ver
  • Başlangıç tarihi Başlangıç tarihi
1Al2Ver

1Al2Ver

Katılım
5 Kasım 2007
Mesajlar
4,727
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Merhaba,

"Süz" sayfasında ; İlk Tarih-Son Tarih ve İsme göre süzdürülerek oluşmuş bir tablodan (Tablo-1), malzemeleri ve miktarları toplayarak oluşan 2 nci bir tablo (Tablo-2) oluşturmak istiyorum,

Teşekkür ederim.
 
Son düzenleme:
bu işlemini pivot table (özet tablo)'dan yapabilirsin.özet tablo da sürükle bırak yöntemiyle olur.
 
martax410' Alıntı:
bu işlemini pivot table (özet tablo)'dan yapabilirsin.özet tablo da sürükle bırak yöntemiyle olur.
Genişletmek için tıkla ...

Merhaba,

Denedim aslında, ama parasal tutar hanesini getirmeyi beceremedim,

İlginize teşekkür ederim.
 
Yardımcı sütunları iptal ettim.Farklı bir formül yazdım. Tablo1 isime göre listelenir. Tablo2'de ise benzersiz olarak listelenir.
 

Ekli dosyalar

Ali' Alıntı:
Yardımcı sütunları iptal ettim.Farklı bir formül yazdım. Tablo1 isime göre listelenir. Tablo2'de ise benzersiz olarak listelenir.
Genişletmek için tıkla ...

Ali bey merhaba,

Öncelikle çözüm için teşekkür etmek istiyorum, sağolun,

Küçük bir ilave rica ediyorum,

"süz" sayfasında, H5:H aralığına, malzemenin stok miktarlarını getirdim,

Tablo-2'de O5:O sütununa da bu miktarları getirmek istiyorum,

Teşekkür ederim.

NOT ; Sorularım , 6 ncı mesajda sayın Recepİpek ve 14 ncü mesajda sayın Ali bey tarafından çözüme kavuşturulmuştur..
 
Son düzenleme:
VBA ile yapılmış alternatif çözümü ekte bulabilirsiniz.

Kod: 
Sub AktarTopla()
Dim a, b, i, n, m, sat1, sat2, veri1(), veri2()
Set s1 = Sheets("Malz.Çıkışı")
Set s2 = Sheets("Süz")
'*******************************************
a = s1.Range("a2:j" & s1.[a65536].End(3).Row).Value
ReDim veri1(1 To UBound(a, 1), 1 To 9)
'*******************************************
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        If Not IsEmpty(a(i, 1)) Then
            If CDate(a(i, 1)) >= CDate(s2.Range("c1")) And CDate(a(i, 1)) <= CDate(s2.Range("c2")) And a(i, 2) = s2.Range("c3") Then
                 z = a(i, 1) & a(i, 2) & a(i, 3) & a(i, 4) & a(i, 5) & a(i, 6)
                    If Not .exists(z) Then
                        n = n + 1
                        veri1(n, 1) = n
                        veri1(n, 2) = a(i, 1)
                        veri1(n, 3) = a(i, 2)
                        veri1(n, 4) = a(i, 3)
                        veri1(n, 5) = a(i, 4)
                        veri1(n, 6) = a(i, 5)
                        veri1(n, 7) = a(i, 6)
                        veri1(n, 8) = a(i, 7)
                        veri1(n, 9) = a(i, 8)
                        .Add z, n
                    End If
            End If
        End If
    Next i
End With
'*******************************************
sat1 = s2.[a65536].End(3).Row + 1
s2.Range(s2.Cells(5, "a"), s2.Cells(sat1, "I")).ClearContents
If Not IsEmpty(veri1(1, 1)) Then s2.[a5].Resize(n, 9).Value = veri1
'****************************************************************************
b = s2.Range("d5:I" & s2.[d65536].End(3).Row).Value
ReDim veri2(1 To UBound(b, 1), 1 To 5)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(b, 1)
           If Not IsEmpty(b(i, 1)) Then
                 If Not .exists(b(i, 1)) Then
                    m = m + 1
                    veri2(m, 1) = m
                    veri2(m, 2) = b(i, 1)
                    .Add b(i, 1), m
                  End If
                    veri2(.Item(b(i, 1)), 3) = veri2(.Item(b(i, 1)), 3) + b(i, 3)
                    veri2(.Item(b(i, 1)), 4) = veri2(.Item(b(i, 1)), 4) + b(i, 5)
                    veri2(.Item(b(i, 1)), 5) = veri2(.Item(b(i, 1)), 5) + b(i, 6)
            End If
    Next
End With
'*******************************************
sat2 = s2.[L65536].End(3).Row + 1
s2.Range(Cells(5, "L"), Cells(sat2, "p")).ClearContents
If Not IsEmpty(veri2(1, 1)) Then s2.[L5].Resize(m, 5).Value = veri2
'*******************************************
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub
 

Ekli dosyalar

Recep İpek' Alıntı:
VBA ile yapılmış alternatif çözümü ekte bulabilirsiniz.

Kod: 
Sub AktarTopla()
Dim a, b, i, n, m, sat1, sat2, veri1(), veri2()
Set s1 = Sheets("Malz.Çıkışı")
Set s2 = Sheets("Süz")
'*******************************************
a = s1.Range("a2:j" & s1.[a65536].End(3).Row).Value
ReDim veri1(1 To UBound(a, 1), 1 To 9)
'*******************************************
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        If Not IsEmpty(a(i, 1)) Then
            If CDate(a(i, 1)) >= CDate(s2.Range("c1")) And CDate(a(i, 1)) <= CDate(s2.Range("c2")) And a(i, 2) = s2.Range("c3") Then
                 z = a(i, 1) & a(i, 2) & a(i, 3) & a(i, 4) & a(i, 5) & a(i, 6)
                    If Not .exists(z) Then
                        n = n + 1
                        veri1(n, 1) = n
                        veri1(n, 2) = a(i, 1)
                        veri1(n, 3) = a(i, 2)
                        veri1(n, 4) = a(i, 3)
                        veri1(n, 5) = a(i, 4)
                        veri1(n, 6) = a(i, 5)
                        veri1(n, 7) = a(i, 6)
                        veri1(n, 8) = a(i, 7)
                        veri1(n, 9) = a(i, 8)
                        .Add z, n
                    End If
            End If
        End If
    Next i
End With
'*******************************************
sat1 = s2.[a65536].End(3).Row + 1
s2.Range(s2.Cells(5, "a"), s2.Cells(sat1, "I")).ClearContents
If Not IsEmpty(veri1(1, 1)) Then s2.[a5].Resize(n, 9).Value = veri1
'****************************************************************************
b = s2.Range("d5:I" & s2.[d65536].End(3).Row).Value
ReDim veri2(1 To UBound(b, 1), 1 To 5)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(b, 1)
           If Not IsEmpty(b(i, 1)) Then
                 If Not .exists(b(i, 1)) Then
                    m = m + 1
                    veri2(m, 1) = m
                    veri2(m, 2) = b(i, 1)
                    .Add b(i, 1), m
                  End If
                    veri2(.Item(b(i, 1)), 3) = veri2(.Item(b(i, 1)), 3) + b(i, 3)
                    veri2(.Item(b(i, 1)), 4) = veri2(.Item(b(i, 1)), 4) + b(i, 5)
                    veri2(.Item(b(i, 1)), 5) = veri2(.Item(b(i, 1)), 5) + b(i, 6)
            End If
    Next
End With
'*******************************************
sat2 = s2.[L65536].End(3).Row + 1
s2.Range(Cells(5, "L"), Cells(sat2, "p")).ClearContents
If Not IsEmpty(veri2(1, 1)) Then s2.[L5].Resize(m, 5).Value = veri2
'*******************************************
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub
Genişletmek için tıkla ...

Sayın Recep İpek, merhaba,

Çok teşekkür ederim, zaman ayırıp makro ile çözüm sunmuşsunuz, çok da güzel olmuş, eliniz sağlık,

Saygılarımla.
 
1Al2Ver' Alıntı:
Ali bey merhaba,

Öncelikle çözüm için teşekkür etmek istiyorum, sağolun,

Küçük bir ilave rica ediyorum,

"süz" sayfasında, H5:H aralığına, malzemenin stok miktarlarını getirdim,

Tablo-2'de O5:O sütununa da bu miktarları getirmek istiyorum,

Teşekkür ederim.
Genişletmek için tıkla ...


Ürüne denk gelen sadece bir değer gelecekse O5 hücrenize

Kod: 
=EĞER(L5="";"";DÜŞEYARA(L5;$C$5:$H$17;6;0))

yazıp aşağı doğru çekiniz.

Ürüne denk gelen tüm değerler toplanıp yazılacaksa O5 hücrenize


Kod: 
=EĞER(L5="";"";ETOPLA($C$5:$C$100;L5;$H$5:$H$100))

yazıp aşağı doğru çekiniz.
 
Sayın 1Al2Ver tarih veri doğrulaması çalışmadığı için dokunamamıştım. Tarihe aralığı ve isime göre süzmede istiyormusunuz.
 
Ali' Alıntı:
Ürüne denk gelen sadece bir değer gelecekse O5 hücrenize

Kod: 
=EĞER(L5="";"";DÜŞEYARA(L5;$C$5:$H$17;6;0))

yazıp aşağı doğru çekiniz.

Ürüne denk gelen tüm değerler toplanıp yazılacaksa O5 hücrenize


Kod: 
=EĞER(L5="";"";ETOPLA($C$5:$C$100;L5;$H$5:$H$100))

yazıp aşağı doğru çekiniz.
Genişletmek için tıkla ...

Ali bey merhaba,

Zahmetleriniz için teşekkür ederim, saygılarımla.
 
Ali' Alıntı:
Sayın 1Al2Ver tarih veri doğrulaması çalışmadığı için dokunamamıştım. Tarihe aralığı ve isime göre süzmede istiyormusunuz.
Genişletmek için tıkla ...

Ali bey tekrar merhaba, mesajını şimdi gördüm,

Hayır sağolun, çözümleriniz fazlasıyla işimi görmekte,

Bu projede ileride başka bir sorunla karşılaşırsam yardımınıza ihtiyacım olabilir,

Tekrar teşekkür ederim, saygılarımla.
 
1Al2Ver' Alıntı:
Ali bey tekrar merhaba, mesajını şimdi gördüm,

Hayır sağolun, çözümleriniz fazlasıyla işimi görmekte,

Bu projede ileride başka bir sorunla karşılaşırsam yardımınıza ihtiyacım olabilir,

Tekrar teşekkür ederim, saygılarımla.
Genişletmek için tıkla ...


Tarihe göre değer alanda bir örnek hazırlamıştım.Ekleyeyim boşa gitmesin.

I sütununada farklı bir benzersiz sayma ile L sütununa isimleri listelettim. Bu örnek önceki örneğe göre daha hızlı çalışır.

Stok-1 ve Stok-2'den hangisi işinizi görüyorsa onu kullanırsınız.
 

Ekli dosyalar

Ali' Alıntı:
Tarihe göre değer alanda bir örnek hazırlamıştım.Ekleyeyim boşa gitmesin.

I sütununada farklı bir benzersiz sayma ile L sütununa isimleri listelettim. Bu örnek önceki örneğe göre daha hızlı çalışır.

Stok-1 ve Stok-2'den hangisi işinizi görüyorsa onu kullanırsınız.
Genişletmek için tıkla ...

Ali bey merhaba,

Zahmetiniz ve emeğiniz için ne kadar teşekkür etsem azdır, sağolun,

Herşey gönlünüzce olsun, saygılarımla.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst