A sütunundaki verilere göre F sütununda topla

[hadromer]

Merhaba,
A sütununda "BAC, MİO, CHL" gibi isimler var.
D sütununda bu isimlerin sayısal değerleri var.
ben, A sütununda yer alan bu isimlerin D sütunundaki sayılarını F sütununda toplayıp, yüzdesini almak istiyorum. Dosya içerisinde çok fazla sayfa var. Tüm sayfalarda sütun pozisyonları sabit. Örnek dosyada nasıl olduğunu göstermeye çalıştım. ÇOKETOPLA formülü burada işime yaramadı.

Örnek Dosya ekledim. Yardımlarınız için teşekkür ederim.

 

[ÖmerFaruk]

Formül olarak bunu kullanabilirsiniz.

=ETOPLA(A:A;A13;D:D)/DÜŞEYARA("TOPLAM";B:D;3;0)*100

 

[hadromer]

Formül olarak bunu kullanabilirsiniz.

=ETOPLA(A:A;A13;D:D)/DÜŞEYARA("TOPLAM";B:D;3;0)*100

Ömer Bey teşekkür ederim ancak bu formülü kullandığım zaman her hücre de aynı değeri gösteriyor. Örnek dosya da F13 hücresinde farklı bir değer var (BAC), F26'da başka bir değer var. İsimleri ayrı ayrı hesaplatacak şekilde olması gerekiyor.

 

[ÖmerFaruk]

Bu formülü 13.satır için verdim.
Formülü tüm sütuna mı uygulamak istiyorsunuz?
Siz soruyu ve örnek dosyanızı nasıl verirseniz ve biz de nasıl anlarsak ancak öyle cevap verebiliyoruz.

 

[hadromer]

Bu formülü 13.satır için verdim.
Formülü tüm sütuna mı uygulamak istiyorsunuz?
Siz soruyu ve örnek dosyanızı nasıl verirseniz ve biz de nasıl anlarsak ancak öyle cevap verebiliyoruz.

yanlış ifade ettiğim için kusura bakmayın lütfen.

Formülü tüm sütuna uygulamak istiyorum. Ekte bulundan dosya içerisinde "örnek" sayfası üzerinden anlatmak istiyorum.
Bu sayfada A sütununda "BAC" ibaresi nerede bitiyorsa F sütunundaki karşılığında hesaplama yapacak. Diğer hücreler boş kalacak . 3-13 satırları BAC. o yüzden F13'te BAC hesaplanmış.
Aynı şekilde dikkat ederseniz 14-26 satır arası "CHL" ismi yer alıyor. 26. satırda CHL bittiği için F26'te hesaplama yapılmış.
27-29 CRY olduğu için F28'de CRY hesaplanmış.

hesaplama yapılırken a sütununda yer alan isimlerin D sütunundaki sayıları kullanılıyor. örnek dosyada manuel olarak formülü eklemiştim neyi nerden hesapladığını size daha iyi gösterebilmek için.

Her sayfada tüm sütunlar sabit. Sadece sütunlardaki veriler değişiyor.

Yardımlarınız için teşekkür ederim.

 

[hadromer]

Bu formülü 13.satır için verdim.
Formülü tüm sütuna mı uygulamak istiyorsunuz?
Siz soruyu ve örnek dosyanızı nasıl verirseniz ve biz de nasıl anlarsak ancak öyle cevap verebiliyoruz.

Eklemeyi unutmuşum, rica etsem bunu makro olarak hazırlamanız mümkün müdür ? eğer sizi yoracaksa formülle de yapabilirim. Teşekkürler

 

[ÖmerFaruk]

F sütununa aşağıdaki formülü uygulayabilirsiniz.
=EĞER(VE(A3="";B3="TOPLAM");TOPLA($F$2:F2);EĞER(VE(A3<>"";A3=A4);"";ETOPLA(A:A;A3;D)/DÜŞEYARA("TOPLAM";B;3;0)*100))

 

[hadromer]

F sütununa aşağıdaki formülü uygulayabilirsiniz.
=EĞER(VE(A3="";B3="TOPLAM");TOPLA($F$2:F2);EĞER(VE(A3<>"";A3=A4);"";ETOPLA(A:A;A3;D)/DÜŞEYARA("TOPLAM";B;3;0)*100))

Ömer Faruk Bey, çok teşekkür ederim, ellerinize sağlık. Tam istediğim gibi çalışıyor.
Sizi daha fazla yormamak adına bu formülü tüm sayfalara uygulayacak yöntemi bulmaya çalışacağım.

 

[ÖmerFaruk]

Sayfa formatlarınız hepsinde aynı ise formüllü kopyalayıp çoğalttığınız sayfadaki F sütunu komple seçip her sayfaya kopyalayabilirsiniz.
Eğer sayfa sayınız ve satır sayılarınız fazla ise ve formüller dosyanızı kasacaksa elbette VBA ile yapılabilir.
Bu durumda da hangi sayfalara hangi hücrelere uygulanacağı ile alakalı kriterleri belirlemelisiniz.

 

[hadromer]

Sayfa formatlarınız hepsinde aynı ise formüllü kopyalayıp çoğalttığınız sayfadaki F sütunu komple seçip her sayfaya kopyalayabilirsiniz.
Eğer sayfa sayınız ve satır sayılarınız fazla ise ve formüller dosyanızı kasacaksa elbette VBA ile yapılabilir.
Bu durumda da hangi sayfalara hangi hücrelere uygulanacağı ile alakalı kriterleri belirlemelisiniz.

ilginiz için teşekkür ederim.
evet sayfa sayım fazla, 200 adet.
çalışma kitabı içerisindeki tüm sayfalarda aynı sütuna uygulayacağım. tüm sayfalar aynı formatta ama sayfalardaki F sütunun hücre sayısı değişiklik gösteriyor. Sayfa isimleri de bazıları numaradan bazıları isimden oluşuyor.

 

[ÖmerFaruk]

Aşağıdaki kodu KOD Penceresinde Bu Çalışma Kitabı kısmına yapıştırın.

Sayfalarınızda veriler 1.satırdan başlayarak devam ediyor olmalı.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim Veri, Liste() As Double, i As Integer, Topla As Double, GenTop As Double
    Veri = Range("A1").CurrentRegion.Value
    ReDim Liste(1 To UBound(Veri), 1 To 1)
    For i = 2 To UBound(Veri) - 1
        If Veri(i, 1) <> "" Then
            Topla = Topla + Veri(i, 4)
            If Veri(i + 1, 1) <> Veri(i, 1) Then
                Liste(i, 1) = Topla / Veri(UBound(Veri), 4) * 100
                Topla = 0
                GenTop = Liste(i, 1) + GenTop
            End If
        End If
    Next i
    Liste(i, 1) = GenTop
    Range("F1").Resize(UBound(Liste), 1) = Liste
    Erase Veri: Erase Liste: Topla = Empty: GenTop = Empty: i = Empty
End Sub

 

[hadromer]

Aşağıdaki kodu KOD Penceresinde Bu Çalışma Kitabı kısmına yapıştırın.

Sayfalarınızda veriler 1.satırdan başlayarak devam ediyor olmalı.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim Veri, Liste() As Double, i As Integer, Topla As Double, GenTop As Double
    Veri = Range("A1").CurrentRegion.Value
    ReDim Liste(1 To UBound(Veri), 1 To 1)
    For i = 2 To UBound(Veri) - 1
        If Veri(i, 1) <> "" Then
            Topla = Topla + Veri(i, 4)
            If Veri(i + 1, 1) <> Veri(i, 1) Then
                Liste(i, 1) = Topla / Veri(UBound(Veri), 4) * 100
                Topla = 0
                GenTop = Liste(i, 1) + GenTop
            End If
        End If
    Next i
    Liste(i, 1) = GenTop
    Range("F1").Resize(UBound(Liste), 1) = Liste
    Erase Veri: Erase Liste: Topla = Empty: GenTop = Empty: i = Empty
End Sub

çok teşekkür ederim, ellerinize sağlık

 

[Ziynettin]

Alternatif;

Do While yapısı ile yapılan çalışma.

Sub Do_While()
    Application.ScreenUpdating = False
    son = Range("A" & Rows.Count).End(3).Row
    x = Application.Sum(Range("D3:D" & son))
    a = Range("A2:D" & son).Value
    i = 2
    ReDim b(1 To UBound(a), 1 To 1)
        Do While i <= UBound(a)
            krt = a(i, 1)
            sat = i
            topla = 0
            say = 0
            Do While a(i, 1) = krt
                say = say + 1
                topla = topla + a(i, 4) / x * 100
                i = i + 1
                If i > UBound(a) Then Exit Do
            Loop
            genel = genel + topla
            b(sat - 2 + say, 1) = topla
        Loop
    [F3].Resize(sat) = b
    Range("F" & son + 1) = genel
    Application.ScreenUpdating = True
    MsgBox "İşlem tamam", vbInformation
End Sub

 

[hadromer]

Alternatif;

Do While yapısı ile yapılan çalışma.

Sub Do_While()
    Application.ScreenUpdating = False
    son = Range("A" & Rows.Count).End(3).Row
    x = Application.Sum(Range("D3:D" & son))
    a = Range("A2:D" & son).Value
    i = 2
    ReDim b(1 To UBound(a), 1 To 1)
        Do While i <= UBound(a)
            krt = a(i, 1)
            sat = i
            topla = 0
            say = 0
            Do While a(i, 1) = krt
                say = say + 1
                topla = topla + a(i, 4) / x * 100
                i = i + 1
                If i > UBound(a) Then Exit Do
            Loop
            genel = genel + topla
            b(sat - 2 + say, 1) = topla
        Loop
    [F3].Resize(sat) = b
    Range("F" & son + 1) = genel
    Application.ScreenUpdating = True
    MsgBox "İşlem tamam", vbInformation
End Sub

çok teşekkür ederim, ellerinize sağlık