• DİKKAT

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

Tutarları gün sayısına bölerek ilgili hücreye taşıma

Sigortadan Poliçeden anlamam ama, tek günler sütununda, iki ayrı firmanın bir yıl süre içinde aynı tarihlerde başlayıp biten poliçe toplamlarını nasıl göstereceğiz. Çakışmıyor mu ? :dusun:
 
Sigortadan Poliçeden anlamam ama, tek günler sütununda, iki ayrı firmanın bir yıl süre içinde aynı tarihlerde başlayıp biten poliçe toplamlarını nasıl göstereceğiz. Çakışmıyor mu ? :dusun:

Merhaba öncelikle teşekkür ederim.. Çakışması yada firması onemli değil..Poliçe bölümünde yazanları gün bölümünde aynı günlere denk geliyorsa 2 poliçe , ikisinin toplamını yazsın. Örneğin a ve b poliçelirinin 2 sininde 15 haziranda 20 ve 25 lira olarak yazması gerekiyorsa , ikisini toplayarak 15 haziranın hücresine yazsın..

Umarım anlatabilmişimdir.
 
Şimdilik şu kodları bir deneyiniz;

Kod:
Sub Emre()
    Dim i As Integer
    Dim evn As Range
    With Sayfa1
    For i = 2 To .Range("A65536").End(3).Row
    Set evn = Sayfa2.Columns(1).Find(.Cells(i, "C"))
        If Not evn Is Nothing Then
            evn.Offset(0, 1).Value = .Cells(i, "E") / (CDate(.Cells(i, "D")) - CDate(.Cells(i, "C")))
            evn.Offset(0, 2).Value = .Cells(i, "F") / (CDate(.Cells(i, "D")) - CDate(.Cells(i, "C")))
            evn.Offset(0, 3).Value = .Cells(i, "G") / (CDate(.Cells(i, "D")) - CDate(.Cells(i, "C")))
        End If
    Next i
    Sayfa2.Select: evn.Select
    End With
    Set evn = Nothing: i = Empty
End Sub
 
Murat bey teşekkürler başlangıç için çok iyi oldu bu.. yontem doğru ancak , poliçe başlangıç tarihinden bitiş tarihine kadar her güne bu rakamları yazmasını istiyorum.örneğin 1.poliçe 15 haziranda başladıysa tabloda 15 hazirana örneğim 1,42 16 hazirana 1,42 17 hazirana 1,42 gibi bitiş tarihine kadar olan güne kadar yazsın istiyorum. 2. veya 3. poliçede aynı günlere denk geliyorsa toplayarak yazsın..

teşekkür edermi.. umarım anlatmışımdır..
 
Anladım ama şu an istediğinizi yapamayacağım. Çıkmam gerek..

Arkadaşlar yardımcı olacaklardır.

İyi akşamlar...
 
Merhaba,

Aşağıdaki kodları dener misiniz?

Kod:
Sub TarihlereAktar()
    
    Dim Shp     As Worksheet, _
        Shg     As Worksheet
    
    Dim i       As Long, _
        GunSay  As Integer
    
    Dim Prim    As Currency, _
        Vergi   As Currency, _
        Sss     As Currency
    
    Dim Tarih   As Date
    
    Dim c       As Range
    
    Set Shp = Sheets("POLICE")
    Set Shg = Sheets("GUN")
    
    Shp.Select
    Application.ScreenUpdating = False
    
    For i = 2 To Shp.Cells(Rows.Count, "A").End(3).Row
    
        Tarih = Shp.Cells(i, "C")
        GunSay = Cells(i, "D") - Cells(i, "C")
        
        Prim = Round(Shp.Cells(i, "E") / GunSay, 2)
        Vergi = Round(Shp.Cells(i, "F") / GunSay, 2)
        Sss = Round(Shp.Cells(i, "G") / GunSay, 2)
        
        Do
            Set c = Shg.Range("A:A").Find(Tarih, LookIn:=xlValues)
            If Not c Is Nothing Then
                Shg.Cells(c.Row, "B") = Shg.Cells(c.Row, "B") + Prim
                Shg.Cells(c.Row, "C") = Shg.Cells(c.Row, "C") + Vergi
                Shg.Cells(c.Row, "D") = Shg.Cells(c.Row, "D") + Sss
            Else
                MsgBox Tarih & " TARİHİ GUN SAYFASINDA BULUNMADI"
            End If
            
            Tarih = Tarih + 1
        Loop While Tarih <= Shp.Cells(i, "D")
        
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "TARİHLERE AKTARILMIŞTIR....", vbInformation, "N. YEŞERTENER ----> [URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
    
End Sub
 

Ekli dosyalar

Necdet bey , sadece başlangış tarihlerine 365 de 1 ini atıyor..Diğer tarihlere yazmıyor.. İlginize teşekkür ederim.
 
Merhaba,

Ben gün olarak değil ay olarak arttırmıştım, yani yanlış anlamışım.

7 nolu mesajı yeniden düzenledim. Dener misiniz?

Gün sayısını bulmak için 2 tarih arasındaki farkı aldım eğer 365 e bölünerek bulunacaksa GunSay değişkenine doğruan 365 atayınız.
 
Geri
Üst