Veri Almak, Diğer Sayfadan Satış Raporu Elde Etmek

[1Al2Ver]

Merhaba,

"Satış_Raporu" sayfasının tüm verilerinin , "Müşteri_Mevcutları" sayfasından makro yardımı ile alınmasını,

TOPLAM sütunlarının da makro ile hesaplanmasını, arzuluyorum.

Detaylı açıklama ve örnekleme, ekli dosyada mevcuttur.

Teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Pivot Table (Özet Tablo) ile kolaylıkla istediğiniz sonucu alabilirsiniz. Hem kullanımı sizin kontrolünüzde olacaktır.

Denemenizi tavsiye ederim..

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Öncelikle ilginiz ve öneriniz için teşekkür ederim,

Çözüm isteğimden önce bu seçeneği denemiş ve başarısız olmuştum,

Öneriniz üzerine yine denemelerim oldu ancak özet tabloyu oluşturamadım, her defasında uyarı alarak sonuçsuz kaldım.

Zamanınız olursa özet tablo ile çözülmüş bir dosya eklemenizi arzularım,

Teşekkür ederim.

 

[1Al2Ver]

Tekrar Merhaba,

Özet Tabloyu, "Örnek Tablo" sayfasından oluşturmaya çalışmışım,

"Müşteri_Mevcutları" sayfasından oluşturunca tablo elde ettim,

Teşekkür ederim.

 

[Korhan Ayhan]

İnceleyiniz.

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Teşekkür ederim, süper bir tablo olmuş, elinize sağlık.

1 nolu mesaj ekindeki dosyada "ÖRNEK_TABLO" sayfasının kodunda, makroda nerede hata yapıyorum,

Öğrenmek istiyorum, bu konuda yardımcı olursanız memnun olurum.

Saygılarımla.

 

[halit3]

Satış raporu sayfasında bu kodu çalıştırın

Sub sirala()
With Application
.Calculation = xlManual '-4135
.ScreenUpdating = False
.EnableEvents = False
End With

sut = 4

sayfaveri = "SATIŞ_RAPORU"
sayfarapor = "MÜŞTERİ_MEVCUTLARI"
Sheets(sayfaveri).Range("E4:AN30").ClearContents

son = Sheets(sayfarapor).Cells(Rows.Count, "b").End(3).Row 'son dolu satır

ReDim ara1(son)

For j = 2 To son
ara1(j) = Month(Sheets(sayfarapor).Cells(j, "a")) & Sheets(sayfarapor).Cells(j, "b")
Next j


For k = 4 To 30
For m = 1 To 12

deg2 = 0
deg1 = 0
aranan1 = m & Sheets(sayfaveri).Cells(k, 3).Value

For r = 2 To son

For i = r To son
If ara1(i) = aranan1 Then
deg2 = deg2 + Sheets(sayfarapor).Cells(i, "e").Value
deg1 = deg1 + Sheets(sayfarapor).Cells(i, "f").Value
End If
Next i

Sheets(sayfaveri).Cells(k, m + sut).Value = deg2
Sheets(sayfaveri).Cells(k, m + sut + 1).Value = deg1
Sheets(sayfaveri).Cells(k, m + sut + 2).Value = deg2 - deg1
GoTo atla

Next r

atla:
sut = sut + 2
Next m
sut = 4
Next k

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

MsgBox "İşleminiz tamamlanmıştır."


End Sub

 

[1Al2Ver]

Sayın halit3 merhaba,

Duyarlığınız ve çözüm için çok teşekkür ederim, elinize sağlık.

Mükemmel olmuş, kod kısa sürede tabloyu oluşturuyor.

Tekrar teşekkür ederim,

Saygılarımla.

 

[halit3]

Koda toplam satırlarını da ekledim.

Sub sirala()
With Application
.Calculation = xlManual '-4135
.ScreenUpdating = False
.EnableEvents = False
End With

sut = 4

sayfaveri = "SATIŞ_RAPORU"
sayfarapor = "MÜŞTERİ_MEVCUTLARI"
Sheets(sayfaveri).Range("E4:AQ30").ClearContents

son = Sheets(sayfarapor).Cells(Rows.Count, "b").End(3).Row 'son dolu satır

ReDim ara1(son)

For j = 2 To son
ara1(j) = Month(Sheets(sayfarapor).Cells(j, "a")) & Sheets(sayfarapor).Cells(j, "b")
Next j


For k = 4 To 30
deg3 = 0
deg4 = 0
For m = 1 To 12

deg2 = 0
deg1 = 0

aranan1 = m & Sheets(sayfaveri).Cells(k, 3).Value

For r = 2 To son

For i = r To son
If ara1(i) = aranan1 Then
deg2 = deg2 + Sheets(sayfarapor).Cells(i, "e").Value
deg1 = deg1 + Sheets(sayfarapor).Cells(i, "f").Value
End If
Next i

Sheets(sayfaveri).Cells(k, m + sut).Value = deg2
Sheets(sayfaveri).Cells(k, m + sut + 1).Value = deg1
Sheets(sayfaveri).Cells(k, m + sut + 2).Value = deg2 - deg1
GoTo atla

Next r

atla:


deg3 = deg3 + Sheets(sayfaveri).Cells(k, m + sut).Value
deg4 = deg4 + Sheets(sayfaveri).Cells(k, m + sut + 1).Value

sut = sut + 2
Next m

Sheets(sayfaveri).Cells(k, "ao").Value = deg3
Sheets(sayfaveri).Cells(k, "ap").Value = deg4
Sheets(sayfaveri).Cells(k, "aq").Value = deg3 - deg4


sut = 4
Next k

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

MsgBox "İşleminiz tamamlanmıştır."


End Sub

 

[1Al2Ver]

Sayın halit3 tekrar merhaba,

Toplamlı çözüm için teşekkür ederim, sorunsuz çalışıyor, sağ olun.

Saygılarımla.