• DİKKAT

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

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

Katılım
5 Kasım 2007
Mesajlar
4,727
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
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

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

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.
 
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.
 
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.
 
Merhaba,

Alternatif olarak bu şekilde de kullanabilirsiniz..

.
 

Ekli dosyalar

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.
 
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.
 
......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.
 
Geri
Üst