Adat Hesaplama- Makro Sorunu

[kumandur]

Merhaba Ekte ilettiğim makro excelinde Adat sekmesinde hesaplama şöyle E sütununda Bakiye hesaplattırıyor , G sütununda gün hesaplattırıyor, H sğtunundaki faiz oranlarını ise Adat sekmesinin B sekmesindeki tarihleri , Faiz sekmesindeki A sütunundaki tarihlerin karşısındaki faiz oranların getirmek istiyorum buradaki ek bir husus diyelim ki Adat sekmesinde B2 deki tarih 01.01.2024 , ancak Faiz sekmesinde bu tarih yok , dolayısı ile Faiz sekmesinde 01.01.2024 tarihinden önceki ilk tarih olan 29.12.2024 tarihindeki Faiz oranını H sütununa yazdırmalı ancak makro hep Adat sekmesindeki H sütununa "0" getiriyor çözüm yolu nedir ? ve sorun nerede ( bunu öğrenmek ve aynı hatayı yapmamak için soruyorum)

Teşekkürler

 

[dost]

Merhaba,

Dosyayı harici link olarak da yükler misiniz.

 

[kumandur]

Merhaba,

Dosyayı harici link olarak da yükler misiniz.

Merhaba dosya linktedir.

Teşekkürler

Ornek.xlsm dosyasını indir - download

Ornek.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[dost]

Sayın @kumandur,

İlk önce sorunuzu cevaplayıp cevaplama konusunda ikilemde kaldım Meslektaşım olduğunuzdan ayrımcılık yapıp sorunuzu cevapladım

1- Sorunuzu yazdığınız cümle dümdüz bir ifade ile yazılmış. Bu nedenle sorunuzu anlamak için zaman harcadım.
2- Excelinizde 25 adet makro mevcut. Hangi makroda düzeltme yapılacak onu anlamaya çalıştım. Yine zaman harcadım.

Umarım harcadığım zamana göre sorunuzu doğru anlamışımdır. Cevap aşağıdadır. (Sadece Faiz oranı kısmını değiştirdim.)

Sub VeriHesaplama()
Dim AdatSayfasi As Worksheet
Dim FaizSayfasi As Worksheet
Dim i As Long
Dim Sonuc As Variant
Dim Gun As Long
Dim Faiz As Double
Dim HesapKodu As String
Dim FisTarihi As Date
Dim Borc As Double
Dim Alacak As Double
Dim Bakiye As Double
Dim FaizOrani As Double
Dim HesaplananFaiz As Double
Dim Katsayi As Double
Dim OncekiBakiye As Double
Dim OncekiTarih As Date
Dim con As Object, RS As Object
Dim strSQL As String

Application.ScreenUpdating = False

' "Adat" ve "Faiz" adlı çalışma sayfalarını belirle
Set AdatSayfasi = ThisWorkbook.Sheets("Adat")
Set FaizSayfasi = ThisWorkbook.Sheets("Faiz")

Set con = CreateObject("AdoDB.Connection")

con.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""


' Veri girişlerini kontrol et ve işlem yap
For i = 2 To AdatSayfasi.Cells(Rows.Count, "A").End(xlUp).Row
    ' Hesap Kodunu al
    HesapKodu = AdatSayfasi.Cells(i, "A").Value
  
    ' Fiş Tarihini al
    FisTarihi = AdatSayfasi.Cells(i, "B").Value
  
    ' Borç ve Alacak değerlerini al
    Borc = AdatSayfasi.Cells(i, "C").Value
    Alacak = AdatSayfasi.Cells(i, "D").Value
  
    ' Borç ve Alacak değerlerine göre bakiyeyi hesapla
    If i = 2 Then
        ' Eğer ilk satırsa önceki bakiye yoktur, direkt hesapla
        Bakiye = Borc - Alacak
    Else
        ' İlk satır değilse önceki bakiyeyi alarak hesapla
        Bakiye = OncekiBakiye + Borc - Alacak
    End If
  
    ' E sütununa bakiyeyi yaz
    AdatSayfasi.Cells(i, "E").Value = Bakiye
  
    ' F sütununa E sütunundaki değeri kopyala
    AdatSayfasi.Cells(i, "F").Value = Bakiye
  
    ' Fiş Tarihine göre gün sayısını hesapla
    If i = 2 Then
        ' Eğer ilk satırsa önceki tarih yoktur, direkt hesapla
        Gun = 1
    Else
        ' İlk satır değilse önceki tarihe göre gün sayısını hesapla
        Gun = DateDiff("d", OncekiTarih, FisTarihi)
    End If
    AdatSayfasi.Cells(i, "G").Value = Gun
  
    ' Fiş tarihini güncelle
    OncekiTarih = FisTarihi
  
    ' Faiz oranını bul
    strSQL = "Select [Tarih], [TP KTF17]  From [Faiz$] " & _
                   "Where Tarih <= " & CLng(OncekiTarih) & " Order By Tarih Desc"
                
    Set RS = con.Execute(strSQL)
  
    FaizOrani = RS(1)
    AdatSayfasi.Cells(i, "H").Value = FaizOrani
  
    ' Hesaplanan faizi hesapla
    HesaplananFaiz = Round((Bakiye * Gun * FaizOrani) / 36500, 2)
    AdatSayfasi.Cells(i, "I").Value = HesaplananFaiz
  
    ' Katsayıyı hesapla
    Katsayi = 0.2
    AdatSayfasi.Cells(i, "J").Value = Katsayi
  
    ' Katsayı ile faizi çarp ve K sütununa yaz
    AdatSayfasi.Cells(i, "K").Value = HesaplananFaiz * Katsayi
  
    ' Önceki bakiyeyi ve tarihi güncelle
    OncekiBakiye = Bakiye
    OncekiTarih = FisTarihi
Next i

Application.ScreenUpdating = True

MsgBox "Veriler başarıyla hesaplandı.", vbInformation, "Tamamlandı"

End Sub

 

[kumandur]

Merhaba Dost ;

Öncelikle teşekkür ederim yazdığınız makro çalışıyor 25 makro nedeni başka sekmeler vardı onları sildim ama geri planda makroları kalmış kusura bakmayın sizi uğraştırdım , VD Komisyon Kararına göre Adat hesaplama tablosu oluşturmaya çalışıyordum düzeltmenizle çalıştırmış olduk, harcadığınız zaman emeğiniz için tekrardan teşekkür ederim.

İyi Çalışmalar .