Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Diğer Excel Soruları
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Diğer Excel Soruları Yukarıdaki başlıklara uymayan Excel sorularınızı bu bölüme gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 15-05-2017, 16:05   #1
m_ek_38
 
Giriş: 02/12/2016
Şehir: ankara
Mesaj: 16
Excel Vers. ve Dili:
excel 2010 türkçe
Varsayılan 6000 sayfalık verıyı sınıflandırmak

Merhaba

Elimde 6000 bin satırlı bir satış raporu var bunların bir bölümünü ekliyorum, benim isteğim

örneğin C2-C8 'e kadar Avakado olan ürünün tek bir satır halinde ve toplam halinde olması rapor gün gün ayrı ayrı yazıyor fakat buna gerek yok tek toplam şeklinde nasıl yapabilirim.

Önerinizden yola çıkarak tüm dosyaya uygulacağım. Pivot table hali var fakat düzenli bir hale getiremedim

http://s5.dosya.tc/server4/4znmsu/ornek.xlsx.html

acil yardımlarınızı bekliyorum teşekkür ederim
m_ek_38 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 15-05-2017, 17:21   #2
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 355
Excel Vers. ve Dili:
office2010
Varsayılan

Merhaba,

Kodu çalıştırdiğınzda verileriniz sayfa2 de listeleniyor.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Rapor()
Dim s1 As Worksheet, S2 As Worksheet, d As Object
Dim a(), b()
Dim i As Long, Say As Long, x As Byte
Set s1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set d = CreateObject("scripting.dictionary")
a = s1.Range("A1:j" & s1.Range("C" & Rows.Count).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
    For i = 1 To UBound(a)
        If Not d.exists(a(i, 3)) Then
            Say = Say + 1
            d(a(i, 3)) = Say
            For x = 1 To 5
                b(Say, x) = a(i, x)
            Next x
        End If
            For x = 6 To 10
                b(d(a(i, 3)), x) = b(d(a(i, 3)), x) + a(i, x)
            Next x
        b(d(a(i, 3)), 9) = a(i, 9)
    Next i

S2.Cells.ClearContents
If Say > 0 Then
    S2.[B2].Resize(Say).NumberFormat = "@"
    S2.[D2].Resize(Say).NumberFormat = "dd.mm.yyyy"
    S2.[E2].Resize(Say).NumberFormat = "@"
    S2.[A1].Resize(Say, UBound(a, 2)) = b
    S2.[F2].Resize(Say, 5).NumberFormat = "#,##0.00"
    S2.[I2].Resize(Say).NumberFormat = "0%"
End If
MsgBox "İşlem tamam....", vbInformation
End Sub
Ziynettin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-05-2017, 07:07   #3
m_ek_38
 
Giriş: 02/12/2016
Şehir: ankara
Mesaj: 16
Excel Vers. ve Dili:
excel 2010 türkçe
Varsayılan

verdiğiniz kodlar çok işime yaradı Allah razı olsun sizden fakat orjinal dosyamda hata ile karşılaşıyorum tabiki hata benim A-J'ye kadar sutunlarım mevcut satır sayım da 5896 da bitiyor kodlarda nereyi değiştirmem gerek
"Run-time error '9':
Subscript out of range
" hatası alıyorum
m_ek_38 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-05-2017, 07:07   #4
m_ek_38
 
Giriş: 02/12/2016
Şehir: ankara
Mesaj: 16
Excel Vers. ve Dili:
excel 2010 türkçe
Varsayılan

Alıntı:
Ziynettin tarafından gönderildi Mesajı Görüntüle
Merhaba,

Kodu çalıştırdiğınzda verileriniz sayfa2 de listeleniyor.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Rapor()
Dim s1 As Worksheet, S2 As Worksheet, d As Object
Dim a(), b()
Dim i As Long, Say As Long, x As Byte
Set s1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set d = CreateObject("scripting.dictionary")
a = s1.Range("A1:j" & s1.Range("C" & Rows.Count).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
    For i = 1 To UBound(a)
        If Not d.exists(a(i, 3)) Then
            Say = Say + 1
            d(a(i, 3)) = Say
            For x = 1 To 5
                b(Say, x) = a(i, x)
            Next x
        End If
            For x = 6 To 10
                b(d(a(i, 3)), x) = b(d(a(i, 3)), x) + a(i, x)
            Next x
        b(d(a(i, 3)), 9) = a(i, 9)
    Next i

S2.Cells.ClearContents
If Say > 0 Then
    S2.[B2].Resize(Say).NumberFormat = "@"
    S2.[D2].Resize(Say).NumberFormat = "dd.mm.yyyy"
    S2.[E2].Resize(Say).NumberFormat = "@"
    S2.[A1].Resize(Say, UBound(a, 2)) = b
    S2.[F2].Resize(Say, 5).NumberFormat = "#,##0.00"
    S2.[I2].Resize(Say).NumberFormat = "0%"
End If
MsgBox "İşlem tamam....", vbInformation
End Sub
verdiğiniz kodlar çok işime yaradı Allah razı olsun sizden fakat orjinal dosyamda hata ile karşılaşıyorum tabiki hata benim A-J'ye kadar sutunlarım mevcut satır sayım da 5896 da bitiyor kodlarda nereyi değiştirmem gerek
"Run-time error '9':
Subscript out of range
" hatası alıyorum
m_ek_38 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-05-2017, 17:32   #5
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 355
Excel Vers. ve Dili:
office2010
Varsayılan

Hatalı dosyayı eklerseniz bakalım.
Ziynettin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 19-06-2017, 14:17   #6
m_ek_38
 
Giriş: 02/12/2016
Şehir: ankara
Mesaj: 16
Excel Vers. ve Dili:
excel 2010 türkçe
Varsayılan

http://www.dosya.tc/server8/c5ztsw/EXAMPLE.xlsx.html

ektedir, parçalayarak formul işe yarıyor fakat tek kalemde çalışması için ne yapmalıyız?
m_ek_38 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 19-06-2017, 14:19   #7
m_ek_38
 
Giriş: 02/12/2016
Şehir: ankara
Mesaj: 16
Excel Vers. ve Dili:
excel 2010 türkçe
Varsayılan

Alıntı:
Ziynettin tarafından gönderildi Mesajı Görüntüle
Hatalı dosyayı eklerseniz bakalım.
yardımlarınızı bekliyorum
m_ek_38 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-06-2017, 23:33   #8
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,743
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan

Sn.m_ek_38 6.mesajda eklediğiniz dosyayı çalıştırdım, bende herhangi bir hata mesajı vermedi, bilginiz olsun.
__________________
Kolay Gelsin Tahsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 28-06-2017, 10:14   #9
m_ek_38
 
Giriş: 02/12/2016
Şehir: ankara
Mesaj: 16
Excel Vers. ve Dili:
excel 2010 türkçe
Varsayılan

Alıntı:
tahsinanarat tarafından gönderildi Mesajı Görüntüle
Sn.m_ek_38 6.mesajda eklediğiniz dosyayı çalıştırdım, bende herhangi bir hata mesajı vermedi, bilginiz olsun.
en son eklediğim EXAMPLE isimli dosya çalışmıyor , çalıssada belli bir kısmı hesaplıyor son satıra kadar işlem yapmıyor bu yüzden parçalamak zorunda kalıyorum.
m_ek_38 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 03:26


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Torna - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Hurda - Lingerie - Dyeing Machine - Çorlu Temizlik- Karton Bardak- Çorlu Pimapenci- İstanbul Avukat- Çorlu Kekemelik- Edirne Su Arıtma- Çorlu Perde Yıkama- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Çorlu İnşaat- Marmara Ereğlisi Yurt- Çorlu Solucan Gübresi- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Su Deposu Temizliği- Bakır Sülfat- Rampa- Rotary-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden