• DİKKAT

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

Ön muhasebe

  • Konbuyu başlatan Konbuyu başlatan mars2
  • Başlangıç tarihi Başlangıç tarihi

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
617
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
İyi Günler;
Excel çalışma kitabımda her ay için 10'ar günlük ön kayıt tablosu bulunmaktadır.
Bu sayfalarda kayıt edilen koda göre sayfa açması ve tüm sayfalarda aynı kodlu olanları altta kayıtemek istiyorum.


Örnek :
Ocak10 sayfasının A sutununda bulunan 792.01 kod bulunması halinde 792.01 sayfanın C sutununa bedeli aynı anda kayıt yapmasını,
eğer 792.01 kod B sutunda bulunması halind ise 792.01 sayfasının D sutununa bedeli kayıt yapmasını istemekteyim.

Konu hakkında yardımcı olacak kardaşlara şimdiden teşekkür ederim.
 

Ekli dosyalar

Aşağıdaki kodları dönem sayfalarının (Ocak10, Ocak20 vs) kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyiniz:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    son = WorksheetFunction.Max(Cells(Rows.Count, "A").End(3).Row, Cells(Rows.Count, "B").End(3).Row) + 1
    sayfalar = Sheets.Count
    dönem = ActiveSheet.Name
    a = Target.Row
If Intersect(Target, Range("A2:B" & son)) Is Nothing Then GoTo 10
    For i = 1 To sayfalar
        If Sheets(i).Name & "a" = Target & "a" Then
            kod = "Var"
        End If
    Next
    If kod <> "Var" Then
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = Target
        ActiveSheet.[A1] = "Tarih"
        ActiveSheet.[B1] = "İzahat"
        ActiveSheet.[C1] = "Borç TL"
        ActiveSheet.[D1] = "Alacak TL"
        ActiveSheet.[A1:D1].Borders.LineStyle = xlContinuous
        ActiveSheet.[A1:D1].Font.Bold = True
        ActiveSheet.[A1:D1].HorizontalAlignment = xlCenter
        ActiveSheet.[A1:D1].VerticalAlignment = xlCenter
    End If
    Sheets(dönem).Activate
10:
If Intersect(Target, Range("E2:F" & son)) Is Nothing Then Exit Sub
        If Target.Offset(0, -4) = "" Then
            MsgBox "Lütfen önce " & Target.Offset(-(a - 1), -4) & "nu giriniz", vbCritical
            Application.EnableEvents = False
            Target = ""
            Application.EnableEvents = True
            Exit Sub
        End If
    
    For i = 1 To sayfalar
        If Cells(a, "A") <> "" Then
            If Sheets(i).Name & "a" = Cells(a, "A") & "a" Then
                kod = "Var"
            End If
        Else
            If Sheets(i).Name & "a" = Cells(a, "B") & "a" Then
                kod = "Var"
            End If
        End If
    Next
    
    If kod <> "Var" Then
        Sheets.Add After:=ActiveSheet
        If Cells(a, "A") <> "" Then
            ActiveSheet.Name = Cells(a, "A")
        Else
            ActiveSheet.Name = Cells(a, "B")
        End If
        
        ActiveSheet.[A1] = "Tarih"
        ActiveSheet.[B1] = "İzahat"
        ActiveSheet.[C1] = "Borç TL"
        ActiveSheet.[D1] = "Alacak TL"
        ActiveSheet.[A1:D2].Borders.LineStyle = xlContinuous
        ActiveSheet.[A1:D1].Font.Bold = True
        ActiveSheet.[A1:D1].HorizontalAlignment = xlCenter
        ActiveSheet.[A1:D1].VerticalAlignment = xlCenter
        ActiveSheet.[C2] = Cells(a, "E")
        ActiveSheet.[D2] = Cells(a, "F")
        ActiveSheet.[C2:D2].NumberFormat = "#,##0.00 $"
    
    Else
        For i = 1 To sayfalar
            If Cells(a, "A") <> "" Then
                If Sheets(i).Name & "a" = Cells(a, "A") & "a" Then
                    yeni = Sheets(i).Cells(Rows.Count, "A").End(3).Row + 1
                    Sheets(i).Cells(yeni, "A") = Date
                    Sheets(i).Cells(yeni, "A").NumberFormat = "dd/mm/yyyy"
                    Sheets(i).Cells(yeni, "B") = Cells(a, "C")
                    Sheets(i).Cells(yeni, "C") = Cells(a, "E")
                    Sheets(i).Cells(yeni, "D") = Cells(a, "F")
                    Sheets(i).Cells(yeni, "C").NumberFormat = "#,##0.00 $"
                    Sheets(i).Cells(yeni, "D").NumberFormat = "#,##0.00 $"
                    Sheets(i).Range("A" & yeni & ":D" & yeni).Borders.LineStyle = xlContinuous
                End If
            Else
                If Sheets(i).Name & "a" = Cells(a, "B") & "a" Then
                    yeni = Sheets(i).Cells(Rows.Count, "A").End(3).Row + 1
                    Sheets(i).Cells(yeni, "A") = Date
                    Sheets(i).Cells(yeni, "A").NumberFormat = "dd/mm/yyyy"
                    Sheets(i).Cells(yeni, "B") = Cells(a, "C")
                    Sheets(i).Cells(yeni, "C") = Cells(a, "E")
                    Sheets(i).Cells(yeni, "D") = Cells(a, "F")
                    Sheets(i).Cells(yeni, "C").NumberFormat = "#,##0.00 $"
                    Sheets(i).Cells(yeni, "D").NumberFormat = "#,##0.00 $"
                    Sheets(i).Range("A" & yeni & ":D" & yeni).Borders.LineStyle = xlContinuous
                End If
            End If
        Next
    End If
    
    Sheets(dönem).Activate

End Sub
 
Sayın Yusuf44;
Cevabınız için teşekkürler. Yapmak istediğim gibi ancak,
1- A sutunda boş hücreye bastığımda yeni boş sayfa açılıyor,
2- aynı hücreye ikinci kec bastığımda yeniden kayıt yapmak olup bu ise sonuçta yanlış hesaplamalara neden olabilecektir.
 
Verdiğim kodlarda sadece hücre seçmeye bağlı herhangi bir işlem yoktur. Bu nedenle boş veya dolu hücreyi seçtiğinizde çalışmaz ve işlem yapmaz. A-b-E ve F sütunlarında "değişiklik yapıldığında" çalışır. Bir şeyleri yanlış mı yaptınız acaba?
 
Sayın Yusuf44;

Verdiğiniz kodu Ocak10 sayfasına yükledim.
Daha önce de bahsettiğim gibi A veyA B sutunundaki boş hücreye Change yaptığımda, ActiveSheet.Name = Target satırında hata vermekte olup sonra yeni bir boş sayfa açılmakta (Sayfa3 gibi)
Kayıt olan hücreye ikinci kez bastığımda yeniden kayıt yapmak olup bu ise sonuçta yanlış hesaplamalara neden olabilecektir.

Örneği yeniden ekledim.
 

Ekli dosyalar

  • hata.jpg
    hata.jpg
    20 KB · Görüntüleme: 2
  • ön muhasebe.xlsm
    ön muhasebe.xlsm
    36.4 KB · Görüntüleme: 27
Hücre boş olduğunda işlem yapmaması için ikinci satır olarak şu satırı kullanın (Private ile son satırları arasına):

Kod:
If Target = "" Then Exit Sub

Kayıt olan hücreye ikinci kez bastığımda ile ilgili hatayı anlamadım.
 
Sayın Yusuf44;
Cevabuınız için teşekkürler,
Kayıt olan hücreye ikinci kez bastığımda ile ilgili hatayı anlamadığınız beyan etmişsiniz.

Örnek:
A sutundaki hücreye 255.01 kodu E sutundaki hücreye 2.500,00 yazıp kayıt ettikten sonra, tekrar aynı hücreye iki kez chang yaptığımda aynı kayıt 255.01 sayfasına kayıt yapmaktadır.

Tarih İzahat Borç TL Alacak TL
07.01.2018 Demirbaş 2.500,00 ₺
07.01.2018 Demirbaş 1.500,00 ₺
07.01.2018 Demirbaş 300,00 ₺
08.01.2018 Demirbaş 2.500,00 ₺
08.01.2018 Demirbaş 2.500,00 ₺
 
Sanıyorum hata yapıldığında düzeltme işleminden bahsediyorsunuz. Bunu yapmak zor. Çünkü isteğiniz kod girildiğinde sayfa açılsın, tutar girildiğinde ilgili sayfaya eklensin şeklindeydi. Bu da verdiğim şekilde yapılır. Sayfada olan her değişiklikte kodlar çalışır ve sayfa yoksa sayfa açar, tutar girilirse ilgili sayfaya ekleme yapar.

Düzeltme için çok farklı bir düzen kurmak gerekiyor. Öncelikle düzeltme yapılan satırdaki kodun sayfasında hangi satırın düzeltileceğinin bilinmesi gerekiyor. Bunun için de yevmiye numarası gibi bir numara sayfalara eklenip, o yevmiye ile ilgili işlem yapıldığında sayfalarda o yevmiyeyi arayıp düzeltme yaptırılabilir.

Ancak ben maalesef nasıl yapılacağını kuramadım. Çünkü kodda düzeltme yapıldığında o kodun sayfasındaki satırın silinmesi, yeni kod için (eğer yoksa) sayfa açılması, buraya yeni bilgilerin girilmesi gibi biraz karışık bir kontrol ve uygulama düzeni gerekiyor.

Ben olsam, her ay için en az 3 sayfa ve her kod için bir sayfa oluşturmak yerine tek bir sayfada icmal şeklinde tüm bilgileri kaydeder, başka bir sayfada da ister özet tablo, ister başka yöntemlerle istediğim raporları çıkarırdım. Sizin çalışma yönteminiz excel için pek uygun değil. İki sayfaya hakim olmak onlarca/yüzlerce sayfaya hakim olmaktan çok daha kolaydır.
 
Sayın Yusuf44;
İyi akşamlar;
önerileriniz için teşekkür ederim, ancak bu önerileriniz doğrultusunda hazırlanmış örnekler bulunmaktamıdır. Yada böyle bir çalışmanız olması halinde sunabilmeniz mümkün müdür.
 
Forumda Ön muhasebe ya da Muhasebe ya da hesap kodları şeklinde arama yapıp konuları incelemenizi öneririm.
 
Geri
Üst