Soru Yatay ve dikey Toplam Alma Hk.

[murat_fidan]

Değerli arkadaşlar paylaşmış olduğum çalışma ile Sayfa2 den Sayfa1 in A sütununa benzersiz verileri çekiyorum. Diğer bir husus ise tabloda bulunan verilerin dikey olarak toplamlarını alıyorum. Buraya kadar sorun yok. Mevcut çalışma şuan bunu yapıyor. Benim artı olarak yapmak istediklerim Sayfa1 e yeni bir benzersiz eklendiği zaman TOPLAM yazan satırın bir üst kısmına eklensin yani toplam satırı hep son satırda kalsın. Diğer bir husus ise verilerin yatay olarakta toplamını aldırmak. Bu konularda yardımcı olursanız sevinirim.

 

[Trilenium]

Pivot table inceleyiniz.

 

[murat_fidan]

Pivot table inceleyiniz.

Makrolu bir çözüm işimi görecek trilenium bey

 

[ÖmerFaruk]

BENZERSİZ Makronuzu aşağıkiyle değiştirin.

Sub BENZERSİZ_Yeni()
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, Say As Long, Liste()
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Arr1 = S2.Range("A1").CurrentRegion.Value
    ReDim Liste(1 To UBound(Arr1), 1 To 1)
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(Arr1)
            If Not .Exists(Arr1(i, 1)) Then
                .Add Arr1(i, 1), 1
                Say = Say + 1
                Liste(Say, 1) = Arr1(i, 1)
            End If
        Next i
    End With
    S1.Range("A2").Resize(Rows.Count - 1, Columns.Count).ClearContents
    S1.Range("A2").Resize(Say, 1) = Liste
    S1.Range("A2").Offset(Say, 0) = "TOPLAM"
    Set S1 = Nothing: Set S2 = Nothing: Erase Liste: Erase Arr1: i = Empty: Say = Empty
End Sub

 

[murat_fidan]

BENZERSİZ Makronuzu aşağıkiyle değiştirin.

Sub BENZERSİZ_Yeni()
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, Say As Long, Liste()
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Arr1 = S2.Range("A1").CurrentRegion.Value
    ReDim Liste(1 To UBound(Arr1), 1 To 1)
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(Arr1)
            If Not .Exists(Arr1(i, 1)) Then
                .Add Arr1(i, 1), 1
                Say = Say + 1
                Liste(Say, 1) = Arr1(i, 1)
            End If
        Next i
    End With
    S1.Range("A2").Resize(Rows.Count - 1, Columns.Count).ClearContents
    S1.Range("A2").Resize(Say, 1) = Liste
    S1.Range("A2").Offset(Say, 0) = "TOPLAM"
    Set S1 = Nothing: Set S2 = Nothing: Erase Liste: Erase Arr1: i = Empty: Say = Empty
End Sub

Teşekkürler Ömer bey listeye yeni bir benzersiz eklenince toplam satırının konumu listenin en altında kalacak şekilde çözümlenmiştir. Son olarak yatay ve dikey olarak toplamlarını aldırabilirsek benim için çok kullanışlı olacak

 

[ÖmerFaruk]

Yatay toplamı, B-C-D....sütunlarına elle veri girişi yaptıktan sonra mı yapacaksınız?
Ayrıca 1.satırdaki Başlıklarınız sabit midir? Yoksa örneğin G sütununa da veri girince oraya da mı başlık yazıyorsunuz?

Eğer böyleyse neden Toplam kısmını B sütununda formülle halledebilirsiniz diyeceğim. Yine de son sütunda alacağım diyorsunuz yukarıdaki soruya verdiğiniz cevaba göre hareket edebilirim.

 

[murat_fidan]

Yatay toplamı, B-C-D....sütunlarına elle veri girişi yaptıktan sonra mı yapacaksınız?
Ayrıca 1.satırdaki Başlıklarınız sabit midir? Yoksa örneğin G sütununa da veri girince oraya da mı başlık yazıyorsunuz?

Eğer böyleyse neden Toplam kısmını B sütununda formülle halledebilirsiniz diyeceğim. Yine de son sütunda alacağım diyorsunuz yukarıdaki soruya verdiğiniz cevaba göre hareket edebilirim.

Toplam kısımlarını formülle halletmeye çalıştım ancak liste sayfasına yeni bir benzersiz ekleyip sizin yazmış olduğunuz makroyu çalıştırınca toplam kısmının değerleri bir üs satırda kalıyor

 

[ÖmerFaruk]

Yatay Toplam dan bahsediyorum ben
Ayrıca siz anladığım kadarıyla önce Benzersizleri A sütununa sıralaycak, sonra B-C-D-E-F..... sütunlarına veri girecek, sonra da Yatay ve diket toplamları oluşturacaksınız. Yanlış mıyım?

 

[murat_fidan]

Yatay Toplam dan bahsediyorum ben
Ayrıca siz anladığım kadarıyla önce Benzersizleri A sütununa sıralaycak, sonra B-C-D-E-F..... sütunlarına veri girecek, sonra da Yatay ve diket toplamları oluşturacaksınız. Yanlış mıyım?

Aynen dediğiniz gibi ömer bey

 

[ÖmerFaruk]

Sütun sayınız sabit mi?
Değilse TOPLAM işlemi yapılmayacak son sütun için bir krtier belirtir misiniz?
Ayrıca Yatay Toplamları B sütununda almak konusunda bir ksııtınız var mı?

 

[murat_fidan]

Sütun sayım sabit,Toplamları B sütununda almak konusunda sıkıntı yok

 

[ÖmerFaruk]

Sabit olan sütun sayınızı 2 kabul ettim. 3.sütun yatay toplam sütununuz.

Yatay Toplamlar B sütununda ise

Sub TOPLAMLAR()
    Son = Range("A" & Rows.Count).End(3).Row
    For i = 2 To Son - 1
        Range("B" & i) = WorksheetFunction.Sum(Range("C" & i, "D" & i))
    Next i
    For i = 2 To 4
        Cells(Son, i) = WorksheetFunction.Sum(Range("A1").Offset(1, i - 1).Resize(Son - 2, 1))
    Next i
End Sub

Eğer D sütunda ise ilk For döngüsündeki toplama satırını değiştirin.
Range("D" & i) = WorksheetFunction.Sum(Range("B" & i, "C" & i))

 

[murat_fidan]

Sabit olan sütun sayınızı 2 kabul ettim. 3.sütun yatay toplam sütununuz.

Yatay Toplamlar B sütununda ise

Sub TOPLAMLAR()
    Son = Range("A" & Rows.Count).End(3).Row
    For i = 2 To Son - 1
        Range("B" & i) = WorksheetFunction.Sum(Range("C" & i, "D" & i))
    Next i
    For i = 2 To 4
        Cells(Son, i) = WorksheetFunction.Sum(Range("A1").Offset(1, i - 1).Resize(Son - 2, 1))
    Next i
End Sub

Eğer D sütunda ise ilk For döngüsündeki toplama satırını değiştirin.
Range("D" & i) = WorksheetFunction.Sum(Range("B" & i, "C" & i))

Teşekkürler Ömer bey istediğim sonucu aldım görselde paylaştığım sıfırlarıda kaldırabilirsek çok daha güzel olacak olmazsada önemi yok tekrardan çok teşekkürler

 

[ÖmerFaruk]

Bu işinizi çözüyor mu?

 

[murat_fidan]

Bu işinizi çözüyor mu?
Ekli dosyayı görüntüle 237681

Teşekkürler Ömer Bey işimi gördü

 

[assenucler]

Sayın Murat_Fidan,


İyi bayramlar dilerim.

Rica etsem, dosyanın son halini paylaşmanız mümkün mü?

Yardımınız için önceden teşekkür ederim.

 

[murat_fidan]

Sayın Murat_Fidan,


İyi bayramlar dilerim.

Rica etsem, dosyanın son halini paylaşmanız mümkün mü?

Yardımınız için önceden teşekkür ederim.

iyi bayramlar hocam
Ben makrolarımı örnek dosya üzerinde değilde ana dosyam üzerinde uyguladım o yüzden paylaşamıyorum. Ömer bey zaten örnek dosyaya göre makroları yazdı buradan alıp örnek dosya üzerinde uygularsanız istediğiniz olacaktır