• DİKKAT

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

Fatura dökümünden Muhasebe Fişleri Oluşturma

B

bertokay

Katılım
31 Temmuz 2006
Mesajlar
60
Excel Vers. ve Dili
Excel 2016
Sayın üstadlarım ekli dosyada fatura sayfasındaki fatura dökümüne göre her fatura satırına ait muhasebe fişi sayfasında muhasebe kayıtları oluşturmaya çalışıyorum ancak bir ayda bin adete yakın fatura kesilebiliyor ve fatura sayfasındaki faturalar kadar muhasebe kayıtlarını oluşturacak formülüzasyonu beceremedim örnek olarak ekli dosyayı yüklüyorum yardımcı olabilirseniz sevinirim.
 

Ekli dosyalar

Böyle bir işlemi formüllerle yapmaya çalışmak veriler çoğaldıkça dosyanızın çok yavaş çalışmasına neden olabilir. Bunun yerine makro ile yapmanızı öneririm.

Makro ile yapabilmek için muhasebe fişini oluşturma kurallarını açık olarak belirtirseniz iyi olur.
 
fatura sayfasındaki ilk iki satır için olması gereken muhasebe fişi kayıtı için kuralı yazmaya çalıştım bu şekilde fatura sayfasındaki fatura satırı kadar muhasebe fişi yaptırmak istiyorum
 

Ekli dosyalar

En son sayfa2 de hücrelerdeki formülü aktif etmek için tek tek üzerine gelip f2 enter yapmam gerekiyor bunu toptan yapmak için ne yapmam gerekiyor.
 

Ekli dosyalar

Formül yerine makroyla yapmak için aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Kod: 
Sub muhasebefişi()
Set s1 = Sheets("FATURA")
Set s2 = Sheets("MUHASEBE FİŞİ")
uyarı = MsgBox("MUHASEBE FİŞİ sayfasındaki eski veriler silinsin mi?", vbYesNo)
If uyarı = vbYes Then
    eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, 2)
    s2.Range("A2:G" & eski).ClearContents
End If
liste = WorksheetFunction.Max(s1.Cells(Rows.Count, "A").End(3).Row, 2)
For i = 2 To liste
    yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
    s2.Range("G" & yeni & ":G" & yeni + 12) = s1.Cells(i, "D")
    s2.Range("F" & yeni & ":F" & yeni + 12) = s1.Cells(i, "G")
    s2.Range("E" & yeni & ":E" & yeni + 12) = s1.Cells(i, "B")
    s2.Cells(yeni, "A") = "611 01 01"
    s2.Cells(yeni + 1, "A") = "611 01 08"
    s2.Cells(yeni + 2, "A") = "611 01 10"
    s2.Cells(yeni + 3, "A") = "611 01 18"
    s2.Cells(yeni + 4, "A") = "120." & s1.Cells(i, "C")
    s2.Cells(yeni + 5, "A") = "600 20 01"
    s2.Cells(yeni + 6, "A") = "600 20 08"
    s2.Cells(yeni + 7, "A") = "600 20 10"
    s2.Cells(yeni + 8, "A") = "611 20 18"
    s2.Cells(yeni + 9, "A") = "391 01"
    s2.Cells(yeni + 10, "A") = "391 05"
    s2.Cells(yeni + 11, "A") = "391 08"
    s2.Cells(yeni + 12, "A") = "391 18"
    
    s2.Cells(yeni, "B") = "%1 Satış İskontosu"
    s2.Cells(yeni + 1, "B") = "%8 Satış İskontosu"
    s2.Cells(yeni + 2, "B") = "KDV'den Muaf Satış İskontosu"
    s2.Cells(yeni + 3, "B") = "%18 Satış İskontosu"
    s2.Cells(yeni + 5, "B") = "%1 İskontolu Satışlar"
    s2.Cells(yeni + 6, "B") = "%8 İskontolu Satışlar"
    s2.Cells(yeni + 7, "B") = "KDV'den Muaf İskontolu Satışlar"
    s2.Cells(yeni + 8, "B") = "%18 İskontolu Satışlar"
    s2.Cells(yeni + 9, "B") = "%1 Hesaplanan KDV"
    s2.Cells(yeni + 10, "B") = "Diğer Tah. Edil. KDV"
    s2.Cells(yeni + 11, "B") = "%8 Hesaplanan KDV"
    s2.Cells(yeni + 12, "B") = "%18 Hesaplanan KDV"
    
    s2.Cells(yeni, "C") = s1.Cells(i, "M")
    s2.Cells(yeni + 1, "C") = s1.Cells(i, "N")
    s2.Cells(yeni + 2, "C") = s1.Cells(i, "L")
    s2.Cells(yeni + 3, "C") = s1.Cells(i, "O")
    s2.Cells(yeni + 4, "C") = s1.Cells(i, "W")
    s2.Cells(yeni + 5, "D") = s1.Cells(i, "H")
    s2.Cells(yeni + 6, "D") = s1.Cells(i, "I")
    s2.Cells(yeni + 7, "D") = s1.Cells(i, "K")
    s2.Cells(yeni + 8, "D") = s1.Cells(i, "J")
    s2.Cells(yeni + 9, "D") = s1.Cells(i, "T")
    s2.Cells(yeni + 11, "D") = s1.Cells(i, "U")
    s2.Cells(yeni + 12, "D") = s1.Cells(i, "V")
    s2.Range("C" & yeni & ":D" & yeni + 12).Style = "Comma"

Next
    
    
End Sub
 
Yusuf Hocam eline sağlık çok teşekkür ediyorum.İlave birşey sormak istiyorum
muhasebe fişi sayfasında C ve D sütunlarında aynı satırda iki sütununda 0 yada boş olduğu satırları sildirmek için sona kod eklemek istersek nasıl düzenleme yapmamız gerekiyor.
 
Aşağıdaki kodları deneyiniz:

Kod: 
Sub muhasebefişi()
Set s1 = Sheets("FATURA")
Set s2 = Sheets("MUHASEBE FİŞİ")
uyarı = MsgBox("MUHASEBE FİŞİ sayfasındaki eski veriler silinsin mi?", vbYesNo)
If uyarı = vbYes Then
    eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, 2)
    s2.Range("A2:G" & eski).ClearContents
End If
liste = WorksheetFunction.Max(s1.Cells(Rows.Count, "A").End(3).Row, 2)
For i = 2 To liste
    yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
    s2.Range("G" & yeni & ":G" & yeni + 12) = s1.Cells(i, "D")
    s2.Range("F" & yeni & ":F" & yeni + 12) = s1.Cells(i, "G")
    s2.Range("E" & yeni & ":E" & yeni + 12) = s1.Cells(i, "B")
    s2.Cells(yeni, "A") = "611 01 01"
    s2.Cells(yeni + 1, "A") = "611 01 08"
    s2.Cells(yeni + 2, "A") = "611 01 10"
    s2.Cells(yeni + 3, "A") = "611 01 18"
    s2.Cells(yeni + 4, "A") = "120." & s1.Cells(i, "C")
    s2.Cells(yeni + 5, "A") = "600 20 01"
    s2.Cells(yeni + 6, "A") = "600 20 08"
    s2.Cells(yeni + 7, "A") = "600 20 10"
    s2.Cells(yeni + 8, "A") = "611 20 18"
    s2.Cells(yeni + 9, "A") = "391 01"
    s2.Cells(yeni + 10, "A") = "391 05"
    s2.Cells(yeni + 11, "A") = "391 08"
    s2.Cells(yeni + 12, "A") = "391 18"
    
    s2.Cells(yeni, "B") = "%1 Satış İskontosu"
    s2.Cells(yeni + 1, "B") = "%8 Satış İskontosu"
    s2.Cells(yeni + 2, "B") = "KDV'den Muaf Satış İskontosu"
    s2.Cells(yeni + 3, "B") = "%18 Satış İskontosu"
    s2.Cells(yeni + 5, "B") = "%1 İskontolu Satışlar"
    s2.Cells(yeni + 6, "B") = "%8 İskontolu Satışlar"
    s2.Cells(yeni + 7, "B") = "KDV'den Muaf İskontolu Satışlar"
    s2.Cells(yeni + 8, "B") = "%18 İskontolu Satışlar"
    s2.Cells(yeni + 9, "B") = "%1 Hesaplanan KDV"
    s2.Cells(yeni + 10, "B") = "Diğer Tah. Edil. KDV"
    s2.Cells(yeni + 11, "B") = "%8 Hesaplanan KDV"
    s2.Cells(yeni + 12, "B") = "%18 Hesaplanan KDV"
    
    s2.Cells(yeni, "C") = s1.Cells(i, "M")
    s2.Cells(yeni + 1, "C") = s1.Cells(i, "N")
    s2.Cells(yeni + 2, "C") = s1.Cells(i, "L")
    s2.Cells(yeni + 3, "C") = s1.Cells(i, "O")
    s2.Cells(yeni + 4, "C") = s1.Cells(i, "W")
    s2.Cells(yeni + 5, "D") = s1.Cells(i, "H")
    s2.Cells(yeni + 6, "D") = s1.Cells(i, "I")
    s2.Cells(yeni + 7, "D") = s1.Cells(i, "K")
    s2.Cells(yeni + 8, "D") = s1.Cells(i, "J")
    s2.Cells(yeni + 9, "D") = s1.Cells(i, "T")
    s2.Cells(yeni + 11, "D") = s1.Cells(i, "U")
    s2.Cells(yeni + 12, "D") = s1.Cells(i, "V")
    s2.Range("C" & yeni & ":D" & yeni + 12).Style = "Comma"

    For j = yeni + 12 To yeni Step -1
        If s2.Cells(j, "C") = "" And Cells(j, "D") = "" Then
            s2.Rows(j).Delete
        End If
    Next
Next
    
    
End Sub

Yalnız siz "boş olanlar" diye belirttiğiniz için ben kodu ona göre düzenledim. Tam olarak istediğiniz sonucu vermeyebilir, "-" yani 0 olan satırları silmez.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst