Sütunda Toplam Aldırma

[dogan081]

Arkadaşlar, Ekli listede bir deneme hazırladım bana lazım olacak olan çalışmamda kullanacaktım. Ancak sütunda arattığım değerleri seçtiğim hücrede toplamasını sağlayamadım. Bu konuda yardımınızı bekliyorum. Bilen arkadşımız varsa bilgisini paylaşırsa çok mutlu olurum Şididen Allah razı olsun...

 

[dogan081]

Arkadaşlar bu konuda paylaşacağınız bir bilgi veya kod arşivi var mı

 

[mrttrn]

Sn dogan081; Aşağıda x ve y ekledim.Galiba sorun çözüldü.
Module1 de

Sub deneme()
[COLOR="#ff0000"]Dim x, y[/COLOR]
Sayfa1.Range("I2") = Sayfa1.Range("a10")
[COLOR="#ff0000"]x = 0[/COLOR]
[COLOR="#ff0000"]y = 0[/COLOR]
For Indeks = 2 To 10
    
    If Sayfa1.Range("a" & Indeks) = Sayfa1.Range("a10") And Sayfa1.Range("B" & Indeks) = "Yonca" Then
   [COLOR="#ff0000"] x = x +[/COLOR] Val(Sayfa1.Range("c" & Indeks))
    Sayfa1.Range("J2") [COLOR="#ff0000"]= x[/COLOR]
    'Sayfa1.Range("d" & Indeks) = Sayfa1.Range("c" & Indeks)
    End If
    If Sayfa1.Range("a" & Indeks) = Sayfa1.Range("a10") And Sayfa1.Range("B" & Indeks) = "Fiğ" Then
    [COLOR="Red"]y = y +[/COLOR] Val(Sayfa1.Range("c" & Indeks))
    Sayfa1.Range("K2") [COLOR="#ff0000"]= y[/COLOR]
    'Sayfa1.Range("e" & Indeks) = Sayfa1.Range("c" & Indeks)
    End If
    Next Indeks

End Sub

 

[Recep İpek]

Yapmak istediğiniz L2 hücresine toplam aldırmak ise, kodlarınıza aşağıdaki satırı ekleyiniz.

Sub deneme()
Sayfa1.Range("I2") = Sayfa1.Range("a10")
For Indeks = 2 To 10
    
    If Sayfa1.Range("a" & Indeks) = Sayfa1.Range("a10") And Sayfa1.Range("b" & Indeks) = "Yonca" Then
    Sayfa1.Range("J2") = Val(Sayfa1.Range("c" & Indeks))
    'Sayfa1.Range("d" & Indeks) = Sayfa1.Range("c" & Indeks)
    End If
    If Sayfa1.Range("a" & Indeks) = Sayfa1.Range("a10") And Sayfa1.Range("b" & Indeks) = "Fiğ" Then
    Sayfa1.Range("K2") = Val(Sayfa1.Range("c" & Indeks))
    'Sayfa1.Range("e" & Indeks) = Sayfa1.Range("c" & Indeks)
    End If
Next Indeks
   [B]Sayfa1.Range("L2") = Sayfa1.Range("J2") + Sayfa1.Range("K2")
[/B]End Sub

 

[dogan081]

Sn dogan081; Aşağıda x ve y ekledim.Galiba sorun çözüldü.
Module1 de

Sub deneme()
[COLOR="#ff0000"]Dim x, y[/COLOR]
Sayfa1.Range("I2") = Sayfa1.Range("a10")
[COLOR="#ff0000"]x = 0[/COLOR]
[COLOR="#ff0000"]y = 0[/COLOR]
For Indeks = 2 To 10
    
    If Sayfa1.Range("a" & Indeks) = Sayfa1.Range("a10") And Sayfa1.Range("B" & Indeks) = "Yonca" Then
   [COLOR="#ff0000"] x = x +[/COLOR] Val(Sayfa1.Range("c" & Indeks))
    Sayfa1.Range("J2") [COLOR="#ff0000"]= x[/COLOR]
    'Sayfa1.Range("d" & Indeks) = Sayfa1.Range("c" & Indeks)
    End If
    If Sayfa1.Range("a" & Indeks) = Sayfa1.Range("a10") And Sayfa1.Range("B" & Indeks) = "Fiğ" Then
    [COLOR="Red"]y = y +[/COLOR] Val(Sayfa1.Range("c" & Indeks))
    Sayfa1.Range("K2") [COLOR="#ff0000"]= y[/COLOR]
    'Sayfa1.Range("e" & Indeks) = Sayfa1.Range("c" & Indeks)
    End If
    Next Indeks

End Sub

Sayın hocam emeğine ve bilgine sağlık. Problemi çözmüşsün Allah razı olsun. Teşekkür ederim Hayırlı akşamlar.

 

[dogan081]

Ripek hocam, ilginize teşşekkür ederim. Problemi şimdi hallettik. Allah kolaylık versin.

 

[Recep İpek]

Peki bu tabloda Yonca ve Fiğ'den başka veri oluyor mu?

 

[dogan081]

Peki bu tabloda Yonca ve Fiğ'den başka veri oluyor mu?

Hocam bibirinden bağımsız 8 ürün olacak. Yapacağım kayıt sisteminde bilgileri alt alta yazıp data oluşturmayı dşünüyordum Bilgiler alt alta ama birbirini takip etmeyen sırada olacağından, rapor oluşturmamda bu formül lazım olacaktı, For Next ile bigileri buldurmayı başardım ama toplamı aldırtamamıştım. Sağolsun mrttrn hocam yadımcı oldu. Umarım bende ihtiyacı olanlara yardımcı olabilirim. excel.web.tr sayesinde paylaşmanın ve yardımlaşmanın güzelliklerini yaşadım ve çok şey öğrendim. Sabırla bize cevap veren herkesden Allah Razı Olsun.

 

[Recep İpek]

Fikir vermesi açısından ekteki çalışmayı inceleyebilirsiniz.

Sub AktarTopla()
Dim a, i, n, k, b()
Set s1 = Sheets("VERİ")
Set s2 = Sheets("RAPOR")
'*******************************************
a = s1.Range("a2:c" & s1.[a65536].End(3).Row).Value
ReDim b(1 To UBound(a, 1), 1 To 11)
veri = Array("Yonca", "Fiğ", "Buğday", "Mısır", "Arpa", "Pamuk", "Çay", "Domates")
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
            If Not IsEmpty(a(i, 1)) Then
                If Not .exists(a(i, 1)) Then
                    n = n + 1
                    b(n, 1) = n
                    b(n, 2) = a(i, 1)
                    .Add a(i, 1), n
                End If
                    For j = 0 To 7
                        If veri(j) = a(i, 2) Then
                            b(.Item(a(i, 1)), j + 3) = b(.Item(a(i, 1)), j + 3) + a(i, 3)
                         End If
                    Next j
                    b(.Item(a(i, 1)), 11) = b(.Item(a(i, 1)), 11) + a(i, 3)
            End If
    Next
End With
s2.Range("a2:k100").ClearContents
s2.[a2].Resize(n, 11).Value = b
sat = s2.[a65536].End(3).Row + 1
s2.Cells(sat, 2).Value = "Genel Toplam"
For s = 3 To 11
s2.Cells(sat, s).Value = WorksheetFunction.Sum(Range(Cells(2, s), Cells(sat - 1, s)))
Next s
'*******************************************
MsgBox "Bitti"
[a1].Select
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[Galus]

Çok güzel bir kodlama. Çok işimne yarayacak. Teşekkürler sayın Ripek.

 

[Recep İpek]

Evet.

Bana göre de çok güzel oldu.

Alta alta olan verileri başka sayfada yan yana toplamını rahatlıkla alabilirsiniz.

 

[dogan081]

Evet.

Bana göre de çok güzel oldu.

Alta alta olan verileri başka sayfada yan yana toplamını rahatlıkla alabilirsiniz.

Hocam vallahi helalin var. Misafirim vardı bakamadım. Yeni baktım kodlaman çok güzel olmuş. Bu konuda kaynak arayanlar içinde arşiv niteliğindedir muhakkak. Teşekkür ederim. Allah razı olsun.