Soru Sol tablodaki verileri süzüp Sağ Tabloya aktarma

Katılım
13 Şubat 2020
Mesajlar
16
Excel Vers. ve Dili
2019
Selamlar Arkadaşlar,

Örnek excel dosyasında solda veriler var. Mesela aynı üründen 3-4 farklı satırda var farklı adetlerde Cam Ölçüleri var. Öncelikle kaç tane cam çeşidi var onu yazacak sonrasında o camların her satırdaki adetlerini toplayacak.

Açıklayıcı bir örnek yaptık anlatmak biraz zor, yardımcı olacak arkadaşlara şimdiden teşekkür ederim. Hayırlı işler dilerim....

Dosya burada :
 
Katılım
13 Şubat 2020
Mesajlar
16
Excel Vers. ve Dili
2019
Allah rızası için yardımcı olacak biri yok mu ? En azından fikir verin... İş döngüye giriyor anlıyoruzda işte o döngü nasıl olacak...
 
Katılım
12 Aralık 2015
Mesajlar
1,200
Excel Vers. ve Dili
Türkçe Ofis 2007
Örneğinizde verilerle rapor birbirini tutmuyor. Cam ölçülerinden hangisi esas alınacak.
 

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,056
Excel Vers. ve Dili
Microsoft Office 2019 English
Büyük Cam ; 90x44 den mi 20 tane var, 70 x 28 den mi 20 tane var ?



233595
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,655
Excel Vers. ve Dili
Microsoft 365 Tr-64
Merhaba, formülle çok uğraşmadım. VBA ile isterseniz aşağıdaki kodları tablonuzun olduğu sayfa1 in kod sayfasına aynen yapıştırın.
B9:K25 aralığında herhangi bir değişiklik yaptığınızda Rapor Alanı kısmında özetiniz çıkacaktır.
Eğer kullandığınız aralık farklı ise kodlarda ufak bir değişiklik yapmak gerekebilir.

C++:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dc As Object, Liste, Veri
    If Intersect(Target, Range("B9:K25")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Range("L10:O25").ClearContents
    Veri = Range("B9:K25").Value
    Set dc = CreateObject("Scripting.Dictionary")
    ReDim Liste(1 To UBound(Veri), 1 To 4)
    For i = 1 To UBound(Veri)
        If Veri(i, 4) <> "Camsız" Then
        For k = 6 To UBound(Veri, 2)
            If Veri(i, k) <> "" Then
                If Not dc.Exists(Veri(i, 4) & Veri(i, k)) Then
                    say = say + 1
                    dc.Add Veri(i, 4) & Veri(i, k), say
                    Liste(say, 1) = Veri(i, 3)
                    Liste(say, 2) = Veri(i, 4)
                    Liste(say, 3) = Veri(i, k)
                    Liste(say, 4) = Veri(i, 1)
                Else
                    Liste(dc(Veri(i, 4) & Veri(i, k)), 4) = Liste(dc(Veri(i, 4) & Veri(i, k)), 4) + Veri(i, 1)
                End If
            End If
        Next k
        End If
    Next i
    Range("L10").Resize(UBound(Liste, 1), 4) = Liste
    Application.EnableEvents = True
End Sub
 
Katılım
13 Şubat 2020
Mesajlar
16
Excel Vers. ve Dili
2019
Arkadaşlar Selamlar,

Biraz rahatszıdım teşekkür ederim, Allah razı olsun sizlerden işim çözüldü. tam anlatamamışım şimdi gördüm mesajları kusura bakmayın. Allah sizden razı olsun hayırlı işleriniz olsun...
 
Üst