Seçime Göre Aktarma ( 2 kritere göre )

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,713
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
Merhaba,

Dosyalarımda oluşan bir karışıklıktan dolayı, önceden kayıt edilmiş bir çözümü kaybettim,

Bu nedenle ; sayfada kayıtlı tablodan, ürün ve ay seçimine göre 2 nci bir tablo oluşturmak istiyorum,

Gerekli formülleri rica ediyorum,

Teşekkür ederim.
 

Ekli dosyalar

Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
Gerçi fonksiyonlarla istemişsiniz ama fantazi olsun diye alternatif olarak makro ile yapılmış çözümü ekte bulabilirsiniz. :)

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [h1,h3]) Is Nothing Then Exit Sub
Dim a, b, i, n, sat, veri()
ay = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık")
sira = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
deg = WorksheetFunction.Match([h3], ay, 0)
ayadi = sira(deg - 1)
'*******************************************
a = Range("a3:e" & [a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1), 1 To 4)
'*******************************************
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        z = a(i, 1)
           If Not IsEmpty(z) And Month(z) = ayadi And a(i, 2) = [h1] Then
                 If Not .exists(z) Then
                    n = n + 1
                    .Add z, n
                    veri(n, 1) = a(i, 1)
                End If
                    veri(.Item(z), 2) = veri(.Item(z), 2) + a(i, 3)
                    veri(.Item(z), 3) = veri(.Item(z), 3) + a(i, 4)
                    veri(.Item(z), 4) = veri(.Item(z), 4) + a(i, 5)
            End If
    Next i
End With
'*******************************************
sat = [g65536].End(3).Row + 1
Range(Cells(14, "g"), Cells(sat, "j")).ClearContents
[g14].Resize(n, 4).Value = veri
''*******************************************
End Sub
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,263
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Yardımcı sütun kullanarak çözüm için aşağıdaki yolu izleyin.

F3 hücresine; (Bu formülü veri sayınız kadar aşağıya doğru sürükleyin.)
Kod:
=EĞER(VE(B3=$H$1;METNEÇEVİR(A3;"aaaa")=$H$3);MAK($F$2:F2)+1;"")
G14 hücresine;
Kod:
=EĞER(EYOKSA(İNDİS($A$3:$A$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1));"";İNDİS($A$3:$A$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1))
H14 hücresine;
Kod:
=EĞER(EYOKSA(İNDİS($C$3:$C$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1));"";İNDİS($C$3:$C$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1))
I14 hücresine;
Kod:
=EĞER(EYOKSA(İNDİS($D$3:$D$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1));"";İNDİS($D$3:$D$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1))
J14 hücresine;
Kod:
=EĞER(EYOKSA(İNDİS($E$3:$E$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1));"";İNDİS($E$3:$E$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1))
Bu formülleride ihtiyacınız kadar aşağıya doğru sürükleyerek çoğaltıp denermisiniz.
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,713
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
Gerçi fonksiyonlarla istemişsiniz ama fantazi olsun diye alternatif olarak makro ile yapılmış çözümü ekte bulabilirsiniz. :)

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [h1,h3]) Is Nothing Then Exit Sub
Dim a, b, i, n, sat, veri()
ay = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık")
sira = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
deg = WorksheetFunction.Match([h3], ay, 0)
ayadi = sira(deg - 1)
'*******************************************
a = Range("a3:e" & [a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1), 1 To 4)
'*******************************************
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        z = a(i, 1)
           If Not IsEmpty(z) And Month(z) = ayadi And a(i, 2) = [h1] Then
                 If Not .exists(z) Then
                    n = n + 1
                    .Add z, n
                    veri(n, 1) = a(i, 1)
                End If
                    veri(.Item(z), 2) = veri(.Item(z), 2) + a(i, 3)
                    veri(.Item(z), 3) = veri(.Item(z), 3) + a(i, 4)
                    veri(.Item(z), 4) = veri(.Item(z), 4) + a(i, 5)
            End If
    Next i
End With
'*******************************************
sat = [g65536].End(3).Row + 1
Range(Cells(14, "g"), Cells(sat, "j")).ClearContents
[g14].Resize(n, 4).Value = veri
''*******************************************
End Sub
Sayın Recep İpek, merhaba,

Öncelikle ayırdığınız zaman için ve gösterdiğiniz önem ve nezaket için teşekkür ederim,

Makrolu çözümünüz güzel olmuş, elinize sağlık,

Saygılarımla.
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,713
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
Selamlar,

Yardımcı sütun kullanarak çözüm için aşağıdaki yolu izleyin.

F3 hücresine; (Bu formülü veri sayınız kadar aşağıya doğru sürükleyin.)
Kod:
=EĞER(VE(B3=$H$1;METNEÇEVİR(A3;"aaaa")=$H$3);MAK($F$2:F2)+1;"")
G14 hücresine;
Kod:
=EĞER(EYOKSA(İNDİS($A$3:$A$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1));"";İNDİS($A$3:$A$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1))
H14 hücresine;
Kod:
=EĞER(EYOKSA(İNDİS($C$3:$C$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1));"";İNDİS($C$3:$C$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1))
I14 hücresine;
Kod:
=EĞER(EYOKSA(İNDİS($D$3:$D$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1));"";İNDİS($D$3:$D$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1))
J14 hücresine;
Kod:
=EĞER(EYOKSA(İNDİS($E$3:$E$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1));"";İNDİS($E$3:$E$65536;KAÇINCI(SATIR()-13;$F$3:$F$65536;0);1))
Bu formülleride ihtiyacınız kadar aşağıya doğru sürükleyerek çoğaltıp denermisiniz.
Sayın Korhan Ayhan, merhaba,

Sorunuma gösterdiğiniz hassasiyet ve ayırdığınız zaman ve çözüm için teşekkür ederim, eliniz sağlık,

Saygılarımla.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Alternatif olarak bu şekilde de kullanabilirsiniz..

.
 

Ekli dosyalar

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,713
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
Merhaba,

Alternatif olarak bu şekilde de kullanabilirsiniz..

.
Sayın Ömer, merhaba,

Problemime gösterdiğiniz ilgi ve alternatif çözüm için çok teşekkür ederim, elinize sağlık,

Saygılarımla.
 

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,645
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
Altın Üyelik Bitiş Tarihi
18-03-2025
sayın korhan hocam ve ömer hocam bende asıl çizelgelerimi bu sonuçları almaya dönük değiştirmeye başladım ve hep bu tarzda sorular sordum son zamanlarda
çözümleriniz için teşekkür

sayın 1Al2Ver sizede teşekkürler ederim diğer çözüm için
soru benim değildi ama arşivime çözümleri aldım
sayın korhan hocamın ilk formülünde buldurduğu 1.2.3 ler formülün can alıcı noktaları bence
sonra tablodan indis formülüyle yada düşeyaya ile istenilenler sonuç tablosuna atılabliyo
sayın ömer hocamda verileri dizi formülüyle bulduruyo çok güzel çözümler.
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,713
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
......sayın 1Al2Ver sizede teşekkürler ederim diğer çözüm için, soru benim değildi ama arşivime çözümleri aldım....
Sayın modoste , merhaba,

Güle güle kullanın, nezaketiniz için de teşekkür ederim.
 
Üst