• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile Mizan oluşturma

W

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
1,080
Excel Vers. ve Dili
excel 2010

excel 2013
Merhaba ,

Ekli örnek dosyada olduğu gibi bir makro çalışması yapılabilir mi. Muhasebe bilgisi olanlar için konu kısaca muavinleri toplatıp mizan oluşturmak, hatta devamında bilanço gelir tablosu gibi mali tablolar.

TEŞEKKÜRLER,
 

Ekli dosyalar

. . .

Mizan sayfasında Hesap Kodları ve İsmi sabit mi yoksa
önce muavinlerden hesap kodlarınımı çıkaracak ?

. . .
 
düzeltme yapıldı

Aslında açıklamam kısa olmuştu. Muavin satırlarının yüzbinlerce olabiileceğini varsayarsak hesap kodları tüm muavin sayfalarındaki hesap kodlarının özeti olmalı, yani benzersiz tek değer. Bu sebeble muavin sayfalarından gelmeli. Kısaca sabit değil.

Benim düşündüğüm mizan sayfasında şöylesi bir buton olacak. Öncelikle muavin sayfalarındaki tüm hesap kodlarını alıp, yinelenleri kaldırıp, sonra sıralarıktan sonra mizana ilgili sütuna yerleştirecek. Daha sonra ise bu kodların (kırılımların ) karşılarına BORÇ ve ALACAK tutarlarının toplamlarını aldıracak. En son olarak da BORÇ BAKİYE ve ALACAK BAKİYE sütunlarında BORÇ ve ALACAK sütunlarının farkı aldırılacak. Burda ifli bir yapı olması gerekiyor. Bu sebeble ilgili dosyayı güncelleyerek tekrardan ekledim. Sanırım daha açıklayıcı olacaktır.
 

Ekli dosyalar

. . .

Hâlen aklımdaki ilk soruyu aşabilmiş değiliz.

Elimizde tüm hesapların olduğu bir liste var mı. Örneğin Hesap Planı sayfasında tüm hesaplar olacak mı.

Tüm sayfaları gezip, tekrar etmeyen listeyi oluşturmak yerine, Hesap Planından listeyi alıp. Daha sonra tutarları boş olanlarını sildirmek daha hızlı ve kolay olur. Bu şekilde kullanmak için Hesap Planı sayfasıda veriler yeterli mi.

. . .
 
Hocam buda olabilir tabi, sonuç olarak hesap planındaki veriler sabit olacak. Buraya göre de işlem yapılabilir. Ancak hesap planına yeni bir hesap ekleme gereğide duyulabilir zamanla. Böylesi bir olasılıkta var malum.
 
Buna şöyle cevap vereyim. Değişken. Kullandığım sistemden veri aldığım zaman 65534 satırın üzerine çıktığında Muavin adlı sayfanın devamı Muavin_1, Muavin_2 ... şeklinde devam etmekte
 
. . .

65 bin satır dolu oluyor mu.
Hımm, aklımda tüm Muavinleri tek sayfada toplamak vardı. Hepsi dolu oluyor ise süre sıkıntısı olur. XLSM formatında çalışmamız daha uygun olur.

. . .
 
Konuya yanıt vermek için aşağıdaki kodları yazdım ama sorular soruldukca konu daki soruyada cevap olarak kodlarıda değiştirmek gerekiyor.

Ben dosyaya iki adet sayfa ekledim data sayfası ve veri sayfası data sayfasına aşağıdaki kodu yazdım.


Kod: 
Sub verileri_bu_sayfaya_aktar()
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
Worksheets("data").Range("B2:E" & sat2).ClearContents

sat1 = Worksheets("Muavin_1").Cells(Rows.Count, "b").End(3).Row
Sheets("Muavin_1").Range("B2:E" & sat1).Copy
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
ActiveSheet.Paste Destination:=Worksheets("data").Range("B" & sat2)

sat3 = Worksheets("Muavin_2").Cells(Rows.Count, "b").End(3).Row
Sheets("Muavin_2").Range("B2:E" & sat3).Copy
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
ActiveSheet.Paste Destination:=Worksheets("data").Range("B" & sat2)

sat4 = Worksheets("Muavin_3").Cells(Rows.Count, "b").End(3).Row
Sheets("Muavin_3").Range("B2:E" & sat4).Copy
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
ActiveSheet.Paste Destination:=Worksheets("data").Range("B" & sat2)

sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1

Application.CutCopyMode = False
Worksheets("data").Range("b2:e" & sat2).Sort Key1:=Worksheets("data").Range("b2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

End Sub


Kod: 
Sub deneme()

sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
Worksheets("data").Range("B2:E" & sat2).ClearContents

For i = 1 To ActiveWorkbook.Sheets.Count
If Mid(Sheets(i).Name, 1, 7) = "Muavin_" Then
'atanacak.AddItem Sheets(i).Name

sat1 = Worksheets(Sheets(i).Name).Cells(Rows.Count, "b").End(3).Row
Sheets(Sheets(i).Name).Range("B2:E" & sat1).Copy
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
ActiveSheet.Paste Destination:=Worksheets("data").Range("B" & sat2)
End If
Next

sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1

Application.CutCopyMode = False
Worksheets("data").Range("b2:e" & sat2).Sort Key1:=Worksheets("data").Range("b2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


End Sub


veri sayfasınada aşağıdaki kodu yazdım.

Kod: 
Sub aktar()

sat1 = Worksheets("veri").Cells(Rows.Count, "b").End(3).Row + 1
Worksheets("veri").Range("B2:g" & sat1).ClearContents

sat = Worksheets("veri").Cells(Rows.Count, "A").End(3).Row + 1


For r = 2 To Worksheets("data").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("data").Cells(r, "b").Value


say4 = 0
say5 = 0

If Sheets("data").Cells(r, "b").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("data").Range("b2:b" & r), aranan1) = 1 Then

For i = r To Worksheets("data").Cells(Rows.Count, "B").End(3).Row
aranan2 = Sheets("data").Cells(i, "b").Value

If aranan2 = aranan1 Then
say4 = say4 + CDbl(Sheets("data").Cells(i, 4).Value)
say5 = say5 + CDbl(Sheets("data").Cells(i, 5).Value)
End If

Next i

Sheets("veri").Cells(sat, 1).Value = Sheets("data").Cells(r, 1).Value
Sheets("veri").Cells(sat, 2).Value = Sheets("data").Cells(r, 2).Value
Sheets("veri").Cells(sat, 3).Value = Sheets("data").Cells(r, 3).Value
Sheets("veri").Cells(sat, 4).Value = say4
Sheets("veri").Cells(sat, 5).Value = say5
If say4 > say5 Then
Sheets("veri").Cells(sat, 6).Value = say4 - say5
Else
Sheets("veri").Cells(sat, 7).Value = say5 - say4
End If
sat = sat + 1

End If
End If
Next r
Sheets("veri").Cells(sat, 4).Value = WorksheetFunction.Sum(Worksheets("veri").Range("D2:D" & sat))
Sheets("veri").Cells(sat, 5).Value = WorksheetFunction.Sum(Worksheets("veri").Range("E2:E" & sat))
Sheets("veri").Cells(sat, 6).Value = WorksheetFunction.Sum(Worksheets("veri").Range("F2:F" & sat))
Sheets("veri").Cells(sat, 7).Value = WorksheetFunction.Sum(Worksheets("veri").Range("G2:G" & sat))

MsgBox " Düzenleme Tamanlanmıştır..."

End Sub
 

Ekli dosyalar

Üstadlar konuyu şimdilik şöyle özetlemeye çalışayım. Benim bahsettiğim konu kısaca muavin adı altında yüzbinlerce satırdan ( hatta milyonu da geçer ) oluşan veriler. Bu kadar yüksek veri topluluğunda çalışmak exceli çok fazla ağırlaştırmakta. Bahsettiğim konuyu ÇOKETOPLA fonksiyonu ile çözebiliyorum ancak malum excel ağırlaşıyor hatta kitlenmekte. Uygun bir makro kodunun buna çözüm olabileceğini düşündüm. Şuan örnek dosya üzerinde hala da çalışmaktayım sizlere tam anlatabilmek için. Ve farklı geliştirmelere uygun olmasını sağlamak için.

Cevaplar için teşekkürler ayrıca.
 
Merhaba,

Sisteminiz yalnız excel olarak mı çıktı verebiliyor? Ona göre çözüm üretilsin bari.

Yalnız excel olarak alabiliyorsanız, ADOX & ADO kitaplığı ile SQL sorgusu kullanılabilecek gibi görünüyor.
 
Zeki Hocam,

Şuan tam hatırlamıyorum ama yanlış değilsem txt, html v.b. farklı şekilde aktarım söz konusu. Bilenler için söylememde fayda olabilir, bahsettiğim sistem Oracle, veri aldığımız sistemde discoverer, burdaki sorgu dilide naçizane bilgime göre PL SQL olması gerekir.

Asıl sorunda şu. Benim şirket bilgisayarımda 2010 excel mevcut. Yani satır sayısı gayet uygun. Ancak discoverer adlı kısımda excele aktar seçeneklerinde uzantı olarak xls tanımlı sadece. Benim yorumum bu sebeble 65. küsür satırın üzerine çıkılamıyor. Veri olarakta 6aylık bir veri aldığımda yani muavin, 700-800 bin satırı bulmakta. Bunu yıllık veri olarak düşünürsek en az iki katı yapar.

Bende bu sorunu aşmak için yine bu siteden bulduğum bir makro ile birden fazla sayfaya aktarmayı çözmeye çalıştım. Ancak Muavinlerdeki hesap kodlarının tutarlarını nasıl toplatacağım buna çözüm bulamadım.
 
Oracle muhasebe fişlerinin bulunduğu tablo yapılarını bilseydik verileri excel, txt, html... gibi dosyalara aktarmadan mizan doğrudan alınabilirdi. Bunu Gus** ERP de yapmıştım. Crystal report ile 2-3 dk. gelen mizanı, 1-2 sn. alabiliyordum.

Konuya gelirsek, text dosyası olarak ve noktalı virgül ( ; ) ayraçlı olarak almayı deneyin. Yani tek bir text dosyası olarak. Performansı bilemem ama sorunuz kolay çözülecek.
 
Zeki hocam,

Örneğin 100.000 satırlık bir veriyi malum şartlar altında excele aktardığımda xls satır sayısının üzerine çıkamıyor. txt şeklinde aktardığımda ise rahatlıkla aktarım yapabiliyor. Yani 500 bin satırlık veri varsa bunu txt olarak alabiliyorum. Ancak burda da txt dosyalarına yansıyan Türkçe karakterlerde. Temel olarak buda işimi görmekte aslında. Bana lazım olan şey muhasebe dilinde hesap kırılımları olan muavin kodları ve bunların tutarları.


Ayrıca bu konuyu açmamdaki sebeblerin birincisi işle ilgili özel bir durum olması ikinci olarak da birçok sitede buna benzer bir örnek ya da makro kodu bulamamış olmam.

Bu arada makro dilini yeni öğrenmeye başladığımı belirtmem gerekir.

İlgilerinize teşekkürler.
 
Text dosyasına aktarmadan önce karakter kodlaması (utf-8, iso8859-9, windows1254 gibi) gibi seçenek varsa onu da ayarlayın. Olmuyorsa bu da aşılabilir. Örnek bir text çıktısı eklerseniz inceleyebiliriz.
 
halit3' Alıntı:
Konuya yanıt vermek için aşağıdaki kodları yazdım ama sorular soruldukca konu daki soruyada cevap olarak kodlarıda değiştirmek gerekiyor.

Ben dosyaya iki adet sayfa ekledim data sayfası ve veri sayfası data sayfasına aşağıdaki kodu yazdım.


Kod: 
Sub verileri_bu_sayfaya_aktar()
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
Worksheets("data").Range("B2:E" & sat2).ClearContents

sat1 = Worksheets("Muavin_1").Cells(Rows.Count, "b").End(3).Row
Sheets("Muavin_1").Range("B2:E" & sat1).Copy
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
ActiveSheet.Paste Destination:=Worksheets("data").Range("B" & sat2)

sat3 = Worksheets("Muavin_2").Cells(Rows.Count, "b").End(3).Row
Sheets("Muavin_2").Range("B2:E" & sat3).Copy
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
ActiveSheet.Paste Destination:=Worksheets("data").Range("B" & sat2)

sat4 = Worksheets("Muavin_3").Cells(Rows.Count, "b").End(3).Row
Sheets("Muavin_3").Range("B2:E" & sat4).Copy
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
ActiveSheet.Paste Destination:=Worksheets("data").Range("B" & sat2)

sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1

Application.CutCopyMode = False
Worksheets("data").Range("b2:e" & sat2).Sort Key1:=Worksheets("data").Range("b2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

End Sub


Kod: 
Sub deneme()

sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
Worksheets("data").Range("B2:E" & sat2).ClearContents

For i = 1 To ActiveWorkbook.Sheets.Count
If Mid(Sheets(i).Name, 1, 7) = "Muavin_" Then
'atanacak.AddItem Sheets(i).Name

sat1 = Worksheets(Sheets(i).Name).Cells(Rows.Count, "b").End(3).Row
Sheets(Sheets(i).Name).Range("B2:E" & sat1).Copy
sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1
ActiveSheet.Paste Destination:=Worksheets("data").Range("B" & sat2)
End If
Next

sat2 = Worksheets("data").Cells(Rows.Count, "b").End(3).Row + 1

Application.CutCopyMode = False
Worksheets("data").Range("b2:e" & sat2).Sort Key1:=Worksheets("data").Range("b2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


End Sub


veri sayfasınada aşağıdaki kodu yazdım.

Kod: 
Sub aktar()

sat1 = Worksheets("veri").Cells(Rows.Count, "b").End(3).Row + 1
Worksheets("veri").Range("B2:g" & sat1).ClearContents

sat = Worksheets("veri").Cells(Rows.Count, "A").End(3).Row + 1


For r = 2 To Worksheets("data").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("data").Cells(r, "b").Value


say4 = 0
say5 = 0

If Sheets("data").Cells(r, "b").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("data").Range("b2:b" & r), aranan1) = 1 Then

For i = r To Worksheets("data").Cells(Rows.Count, "B").End(3).Row
aranan2 = Sheets("data").Cells(i, "b").Value

If aranan2 = aranan1 Then
say4 = say4 + CDbl(Sheets("data").Cells(i, 4).Value)
say5 = say5 + CDbl(Sheets("data").Cells(i, 5).Value)
End If

Next i

Sheets("veri").Cells(sat, 1).Value = Sheets("data").Cells(r, 1).Value
Sheets("veri").Cells(sat, 2).Value = Sheets("data").Cells(r, 2).Value
Sheets("veri").Cells(sat, 3).Value = Sheets("data").Cells(r, 3).Value
Sheets("veri").Cells(sat, 4).Value = say4
Sheets("veri").Cells(sat, 5).Value = say5
If say4 > say5 Then
Sheets("veri").Cells(sat, 6).Value = say4 - say5
Else
Sheets("veri").Cells(sat, 7).Value = say5 - say4
End If
sat = sat + 1

End If
End If
Next r
Sheets("veri").Cells(sat, 4).Value = WorksheetFunction.Sum(Worksheets("veri").Range("D2:D" & sat))
Sheets("veri").Cells(sat, 5).Value = WorksheetFunction.Sum(Worksheets("veri").Range("E2:E" & sat))
Sheets("veri").Cells(sat, 6).Value = WorksheetFunction.Sum(Worksheets("veri").Range("F2:F" & sat))
Sheets("veri").Cells(sat, 7).Value = WorksheetFunction.Sum(Worksheets("veri").Range("G2:G" & sat))

MsgBox " Düzenleme Tamanlanmıştır..."

End Sub
Genişletmek için tıkla ...

Bu kodlar ekteki dosyaya uygulanabilir mi. Birde kodların ne anlama geldiği, nasıl çalıştığı açıklanabilirse memnun olurum. Üzerinde ekleme yaparak dosya benim istediğim şekilde görünüyor, ancak sütun sayılarında ya da yerlerinde değişiklik olduğu zaman ya da sayfa isimlerinde değişiklik olursa sonuç değişir tam çözemedim. Ekteki yeni veriler sistem verileridir.
 

Ekli dosyalar

düzenleme

Merhaba,

Konu başlığındaki talebime istinaden ekli dosyada olduğu gibi bir değişiklik yapmak istedim. Halit beyin uyguladığı makrolar talebime genel olarak yanıt verebilmekte. Kendimce basit uyarlamalar yapmaya çalıştım.

Ancak çalışırken şöylesi bir konu aklıma geldi. Ben sistemden bir veri alıyorum. Bu veriler adı sabit olan bir excel kitabına aktarılıyor. Bilgisayardaki adı yeri sabit. Sadece veri büyüklüğü değişmekte, sayfa sayıları artmakta ya da azalmakta. Ancak bu dosyada sistemden gelen makrolar, şekiller, kenarlıklar v.b. şeyler olabilmekte.

Bu sebeple sürekli olarak böylesi bir excel dosyasının üzerinde oynamaktansa verileri yeni bir excel kitabına alıp verileri bu dosya üzerinde işleme şeklinde bir düşünce oluştu.

Ekteki örnek dosyada açıklama sayafsında detaylı anlatım mevcut.

Mümkünmüdür?

Teşekkürler,
 

Ekli dosyalar

Eklediğiniz dosyada "Muavin..." isimli sayfalarda "A" sütunun bu şekilde mi çıkıyor. Yoksa siz sonradan mı eklediniz.

Sistemden aldığınız ham veri tablosunu ve oluşmasını istediğiniz mizan tablosunu ayrı dosyalar olarak eklerseniz daha hızlı çözüme gidebiliriz.
 
Korhan Bey merhaba,

Bu şekilde çıkmıyor , benim yaptığım uyarlamalar vardı. Ancak şunu diyebilirim. Sistemden gelen veriler 21 sütundan oluşmakta. Diğer bir ifade ile A sütunu ile T sütunu arası. 21 sütunun hepsi veri olarak kullanılabilen sütunlar değil. Bunların 4-5 tanesi kullanılmakta.

Benim elimde dediğim gibi sistemden veriyi aktardığım bir excel kitabı var. Bu excel kitabının konumu, adı aynı. Sadece veri çokluğuna bağlı olarak sayfalar değişmekte. Artabilir, azalabilir. Bu verilerin oluştuğu excel kitabıda xls. Yani bir sayfa en fazla 65536 satır. Ben ise xlsm kitabında böylesi bir veriyi alt alta toplatabilirim die düşündüm.


Bu şartlar altında benim istedim şöylesi bir şey. Bir makro kodları içeren kitapta bu verileri toplamak. Yani muavinleri toplamak. Ancak ham verilerin olduğu kitaptan tüm sütunları değil de bana lazım olan sütunları getirmek. Böylece boş veri yükünden arınmış olunur. Son olarakta Mizan olarak bahsettiğim tablonun oluşturulması.

Teşekkürler.
 
Korhan Ayhan' Alıntı:
Eklediğiniz dosyada "Muavin..." isimli sayfalarda "A" sütunun bu şekilde mi çıkıyor. Yoksa siz sonradan mı eklediniz.

Sistemden aldığınız ham veri tablosunu ve oluşmasını istediğiniz mizan tablosunu ayrı dosyalar olarak eklerseniz daha hızlı çözüme gidebiliriz.
Genişletmek için tıkla ...


Korhan bey ve diğer üstatlar merhaba,

Yazdığınız cevaba karşılık ekte iki yeni örnek sunmaktayım. Mizan adlı kitabın açıklama sayfasında yapmak istediğim şeyi üzerine bir kaç yeni ekleme yaparak detaylı anlatmaya çalıştım. Bu son çalışma kanımca daha yerinde oldu. Umarım rica ettiğim şeyler yapılabiliyordur. İstediğim şeyler yapılabilirse Muhasebeyle ilgilenen bir çok kişide bu örnek uygulamadan faydalanabilecektir die umuyorum.

Teşekkürler,
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst