[Yardım]  VBA Alt Toplam

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

VBA Alt Toplam

İleti#1)  bumeray » 26 Mar 2020 16:40

Merhabalar,
Tarih, İsim ve Tutar sütunlarının bulunduğu excel sayfasında makro ile alt toplam almak istiyorum. Sitenizi araştırdığımda http://www.excelvba.net/viewtopic.php?f=4&t=14836 adresinde konuyu buldum. (Konu şu anda kilitli olduğu için yeni konu açtım). Bu konuda çözüm olarak anlatılan kodları uyguladım. Konudaki örnekte aynı isimler alt alta sıralandığından benim de isimlerim karışık olduğundan kodları bir türlü kendime uyarlayamadım. Sanırım şart ile ilgili kodu değiştirmem gerek ama değiştiremedim. Ekteki dosyada kodlar yer almaktadır. İlgilenen arkadaşlar dosyayı inceleyebilirlerse soru daha iyi anlaşılacaktır. Teşekkür eder sağlıklı günler dilerim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
bumeray
Yeni Başlamış
 
Adı Soyadı:Mehmet Gönüldas
Kayıt: 01 Nis 2012 18:20
Konum: HATAY
Meslek: SMMM
Yaş: 43
İleti: 54
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: HATAY

Cevap: VBA Alt Toplam

İleti#2)  hasan14 » 26 Mar 2020 20:01

Deneyiniz.
Kod: Tümünü seç
Sub Alttopla()
Dim s1 As Worksheet: Dim son As Long
Dim sd As Object: Dim i As Long
Dim liste() As Variant: Dim Dizi() As Variant
   Set s1 = Sheets("ev")
    son = s1.Cells(1048541, "C").End(3).Row
    liste = s1.Range("C1:D" & son).Value
    Set sd = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(liste, 1)
    If liste(i, 1) <> "" Then
    aranan = liste(i, 1)
    If Not sd.Exists(aranan) Then
            say = say + 1
            sd.Add aranan, say
            ReDim Preserve Dizi(1 To son, 1 To 2)
            Dizi(say, 1) = liste(i, 1)
            End If
        Dizi(sd.Item(aranan), 2) = Dizi(sd.Item(aranan), 2) + liste(i, 2)
        End If
    Next i
If sd.Count > 0 Then
s1.Range("F1:F" & Cells(65355, "F").End(3).Row).ClearContents
s1.Range("F1").Resize(sd.Count, 2) = Dizi
    MsgBox "İşlem tamam"
   Else
   MsgBox "İşlem tamam"
    End If
    End Sub
Kullanıcı avatarı
hasan14
Siteye Alışmış
 
Kayıt: 28 Ağu 2016 15:26
Meslek: eğitim
Yaş: 59
İleti: 478
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: zonguldak

Cevap: VBA Alt Toplam

İleti#3)  bumeray » 26 Mar 2020 20:49

Sayın Hasan Bey, Teşekkür ederim. Sağlıcakla kalın [TESEKKÜR]
Kullanıcı avatarı
bumeray
Yeni Başlamış
 
Adı Soyadı:Mehmet Gönüldas
Kayıt: 01 Nis 2012 18:20
Konum: HATAY
Meslek: SMMM
Yaş: 43
İleti: 54
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: HATAY

Cevap: Cevap: VBA Alt Toplam

İleti#4)  hasan14 » 27 Mar 2020 07:23

bumeray yazdı:Sayın Hasan Bey, Teşekkür ederim. Sağlıcakla kalın [TESEKKÜR]

Rica ederim.Dönüş yaptığınız için teşekkür ederim. --)(
Kullanıcı avatarı
hasan14
Siteye Alışmış
 
Kayıt: 28 Ağu 2016 15:26
Meslek: eğitim
Yaş: 59
İleti: 478
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: zonguldak

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 3 misafir

cron
Bumerang - Yazarkafe