Benzersiz Sırala ve Toplam Al

[thinker]

Merhaba aranıza katılmaktan mutluluk duyuyorum.

Şöyle bir sorum olacaktı.

Excelde s1 sayfasında

Sip No Ürün Adı Adet1 Adet2 Adet3
585 Elma 10 0 20
585 Armut 8 5 5
620 Kavun 20 7 0
625 Üzüm 0 0 3


s2 sayfasında
Sip No Ürün Adı Adet1 Adet2 Adet3
585 Elma 5 0 0
585 Armut 0 7 9
620 Kavun 10 15 10
620 Şeftali 0 30 0
675 Karpuz 1 0 5
750 Muz 0 2 0


s3 sayfasında
Sip No Ürün Adı Adet1 Adet2 Adet3
585 Elma 19 8 0
585 Armut 0 0 4
585 Ananas 5 3 0
675 Karpuz 0 0 8
750 Muz 20 20 20
999 Portakal 7 7 0

şeklinde veriler var. İsteğim Toplam sayfasında

Sip No Ürün Adı Adet1 Adet2 Adet3
585 Elma T? T? T?
585 Armut
585 Ananas
620 Kavun
620 Şeftali
625 Üzüm
675 Karpuz
750 Muz
999 Portakal

Şeklinde sipariş nosuna ve ürün adına göre benzersiz sıralayıp Adet1,Adet2 ve Adet3 toplamlarını tabloya yazdırması.

Saygılarımla

 

[Ali]

Aşağıdaki linki bir inceleyin.

http://www.excel.web.tr/viewtopic.php?t=18767

 

[Korhan Ayhan]

Selamlar,

Aramıza hoşgeldiniz.

Örnek bir dosya eklermisiniz.

 

[thinker]

Sayın Fructose sizin çalışmanızı inceledim, mükemmel bir çalışma. Ama excel konusunda sizin kadar iyi olmadığım için tek başıma dosyama uyarlamam zor. Bu yüzden örnek dosya üzerinde yardım istemek daha mantıklı gibi geldi bana. İlginiz için teşekkür ederim.

Toplam sayfasına s1,s2 ve s3 sayfalarından sipariş no ve ürün adı benzersiz olarak gelecek ve toplamlar alınacak.

 

[veyselemre]

Eki inceleyin.

 

[thinker]

İnceledim ve süper olmuş çok teşekkür ederim sadece bir sorum var bunu butona bağlamadan sayfayı seçince otomatik bağlayabilirmiyiz. activate olayıyla yani

 

[veyselemre]

Toplam sayfasının kod kısmına aşağıda kodu yapıştırın.
[vb:1:abbe7f9f72]Private Sub Worksheet_Activate()
Range("a2:e65536").ClearContents

Sayfalar = Array("s1", "s2", "s3")
For x = 0 To 2
Set s = Sheets(Sayfalar(x))
son = s.[a65536].End(3).Row

For y = 2 To son
SonT = [a65536].End(3).Row
If SonT = 1 Then GoTo Yok

For m = 2 To SonT
If s.Cells(y, 1) = Cells(m, 1) And s.Cells(y, 2) = Cells(m, 2) Then
For k = 3 To 5
Cells(m, k) = Cells(m, k) + s.Cells(y, k)
Next k
GoTo atla
End If
Next m

Yok:
SonT = [a65536].End(3).Row
For k = 1 To 5
Cells(SonT + 1, k) = s.Cells(y, k)
Next k
atla:
Next y

Next x

Range("A2:E" & [a65536].End(3).Row).Sort Key1:=Range("A2"), Key2:=Range("B2")
End Sub[/vb:1:abbe7f9f72]

 

[thinker]

evet veysel bey süper süper süper Çok teşekkür ederim. Son bir soruyla konuyu kapatmak istiyorum. Bu dosyada aynı özelliklere sahip s4 s5 ..... s15'e kadar sayfalar olsa ve hazır istemişken bu sayfalarda adet1, adet2 ve adet3 ler adet300'e kadar uzasa kodda nasıl bir düzenleme yapabilirim , ben biraz uğraştım ama beceremedim

 

[Korhan Ayhan]

Selamlar,

Adetlerin 300 olması tek sayfada imkansız ancak iki sayfaya bölünebilir çünkü sütun olarak 256 adet kullanabiliyoruz şuan için eğer son office programını kullanmıyorsanız. :hey:

 

[veyselemre]

Sayfaları Sayfalar = Array("s1", "s2", "s3") dizisisine ekleyin.
Sayfalar = Array("s1", "s2", "s3", "s4","s5") gibi

For x = 0 To 2 kısımını da For x = 0 To ubound(sayfalar)

Adetler içinde For k = 3 To 5 ve For k = 1 To 5 de 5.sutuna kadar alıyor, siz 5 sayısını değiştirebilirsiniz. (en fazla 256)

 

[thinker]

300 öylesine söylediğim bir rakamdı. 256 sınırı konusunda haklısınız COST CONTROL ve veyselemre. Kodlarla ilgili olarak söylediğiniz düzenlemeleri yaptım ve işe yaradı . Çok teşekkür ederim. Beni büyük bir zahmetten kurtardınız.

 

[thinker]

Bu kodla ilgili olarak s10'a ve adet100'e kadar deneme yaptım ve harika çalıştı. Ama amirlerim yeni bie dert çıkardı. Dediler ki toplam sayfasında her 5 adetten sonra toplam alsın dediler. Özetle Toplam sayfasında sütunlar aşağıdaki gibi olsun istiyorlar.

Adet1 Adet2 Adet3 Adet4 Adet5 TOPLAM Adet6 Adet7 Adet8 Adet9 Adet10 Toplam ..........................

Bunuda koda eklemek mümkünmü acaba?

 

[veyselemre]

Dosyanızın son halini ekleyin, üzerinde bakalım...

 

[thinker]

Son halini ekledim. Dediğim gibi toplam Sayfasınada adet5 sütunundan sonra toplam adet10 sütünunundan sonra toplam isteniyor. Tani her 5 sütünda bir toplam.

 

[veyselemre]

Eki inceleyin,

 

[thinker]

Çok teşekkür ederim Veysel Bey. Ne sorsam cevap aldım. Yardımlarınız için müteşekkirim. Saygılar