[Yardım]  Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

Excel hakkındaki soru ya da paylaşımlarınıza kategori bulamadıysanız bu alana yazabilirsiniz.

Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#1)  hizmeteozel » 31 Tem 2019 10:31

Merhaba değerli arkadaşlar;

Ekte yer alan dosyada görüleceği üzere üç sayfalık bir çalışma kitabında "VERİ" isimli ilk sayfanın ilk sütununda Q1,Q2,Q3,Q4,.... şeklinde bir benzersiz ad tanımlaması ve her birinin karşısında ikinci sütunda ise birer tarih verisi var.

Çalışma kitabının "TABLO" isimli ikinci sayfasının ilk sütununda "DİZİ NO" başlığı altında 1'den başlayıp sonsuza devam eden sayı dizisi bulunurken her bir sayının karşısında yılın ilk günü ile son gününü tarih olarak zaman aralığı şeklinde belirleyen iki sütün var. En sonda ise bu iki sütun aralığındaki ay sayısını ETARİHLİ formülü ile hesaplayan bir sütun var.

Yapmak istediğim şeyi ise "OLMASI İSTENEN" isimli üçüncü sayfada gösterdim. Buna göre "VERİ" isimli sayfadaki değerlere istinaden "TABLO" da zaman aralığını parçalamak, fark ay sayısını hesaplattırmak ve parçalanan zaman aralığı için tabloda ilgili kısma bir boş satır eklettirmek istiyorum.

Dikkat edilecek husus ise "TABLO" sayfasının "C" sütununda "VERİ" sayfasındaki tarihlerde gün değeri 15'in altında ise bir önceki ayın son günü, 15 ve üstünde ise bir sonraki içinde bulunulan ayın son günü yazmalı ve devam eden satır başlangıcı da buna uygun ilerleyecek şekilde olmalı, parçalanan zaman aralığı için devam eden "DİZİ NO" aynı olmalı, yıl sonu ise devam eden "DİZİ NO" değişmemeli. (Örnek sayfada dizi no için bu hususa vurgu maksadı ile renklendirme yaptım ki fark kolay anlaşılabilsin)

Bunu formülle yaptırmak pek mümkün değil anladığım kadarı ile. Mümkünse formülle yapmayı yeğlerim ama değil ise makro da olur. Şimdiden teşekkür ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hizmeteozel
Yeni Başlamış
 
Kayıt: 14 Eyl 2018 09:28
Meslek: Avukat
Yaş: 44
İleti: 15
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Manisa

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#2)  Feyzullah » 01 Ağu 2019 14:56

Kod: Tümünü seç
Sub exceldestek80()
Dim t As Worksheet: Set t = Sheets("TABLO")
Dim v As Worksheet: Set v = Sheets("VERİ")
With Sheets("OLMASI İSTENEN")
.
Range("A2:E" & .Cells(Rows.Count, 1).End(xlUp).Row + 5).ClearContents: sat = 1
For a 
= 2 To t.Cells(Rows.Count, 1).End(xlUp).Row
    sat 
= sat + 1
    
.Cells(sat, 1) = t.Cells(a, 1)
    .Cells(sat, 2) = Format(t.Cells(a, 2), "dd.mm.yyyy")
    .Cells(sat, 3) = Format(t.Cells(a, 3), "dd.mm.yyyy")
    .Cells(sat, 4).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
For b = 3 To v.Cells(Rows.Count, 1).End(xlUp).Row
    If Year
(t.Cells(a, 2)) = Year(v.Cells(b, 2)) Then
        
.Cells(sat, 3) = DateSerial(Year(t.Cells(a, 3)), Month(v.Cells(b, 2)), Day(WorksheetFunction.EoMonth(v.Cells(b, 2), 0)))
        sat = sat + 1
        
.Cells(sat, 5) = v.Cells(b, 1)
    If Month(v.Cells(b, 2)) <> 12 Then
        sat 
= sat + 1
        
.Cells(sat, 1) = t.Cells(a, 1)
        .Cells(sat, 2) = DateSerial(Year(t.Cells(a, 3)), Month(v.Cells(b, 2) + 1), Day(1))
        .Cells(sat, 3) = Format(t.Cells(a, 3), "dd.mm.yyyy")
        .Cells(sat, 4).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    End If
    End If
Next b
, a
End With
MsgBox 
"...:İşlem Tammamlandı:..." & vbCrLf & vbCrLf & _
"                 Metehan8001 / Feyzullah", vbInformation + vbMsgBoxRtlReading, "www.ExcelDestek.Com"
End Sub
Kullanıcı avatarı
Feyzullah
Site Dostu
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 08:30
İleti: 720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#3)  hizmeteozel » 02 Ağu 2019 13:29

Feyzullah bey çok teşekkür ederim.

Upload ettiğim dosyada sadece ne yapmak istediğimi somutlaştırmak için "OLMASI İSTENEN" isimli sayfayı çalışma kitabına eklemiştim. Yani kitapta aslında 3 sayfa yok. Sadece VERİ ve TABLO sayfaları var. Ben makro kodunun TABLO sayfasında "OLMASI İSTENEN" sayfasında gösterilen şekilde değişiklik yapmasını istiyorum. Mümkün mü acaba?

Tekrar teşekkür ederim.
Kullanıcı avatarı
hizmeteozel
Yeni Başlamış
 
Kayıt: 14 Eyl 2018 09:28
Meslek: Avukat
Yaş: 44
İleti: 15
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Manisa

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#4)  Feyzullah » 02 Ağu 2019 17:22

Kod: Tümünü seç
Sub exceldestek()
Dim t As Worksheet: Set t = Sheets("TABLO")
Dim v As Worksheet: Set v = Sheets("VERİ")
son = t.Cells(Rows.Count, 1).End(xlUp).Row
vtablo 
= t.Range("A2:D" & son)
t.Range("A2:E" & son + 5).ClearContents: sat = 1
For a 
= 1 To son - 1
    sat 
= sat + 1
    t
.Cells(sat, 1) = vtablo(a, 1)
    t.Cells(sat, 2) = Format(vtablo(a, 2), "dd.mm.yyyy")
    t.Cells(sat, 3) = Format(vtablo(a, 3), "dd.mm.yyyy")
    t.Cells(sat, 4).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
For b = 3 To v.Cells(Rows.Count, 1).End(xlUp).Row
    If Year
(vtablo(a, 2)) = Year(v.Cells(b, 2)) Then
        t
.Cells(sat, 3) = DateSerial(Year(vtablo(a, 3)), Month(v.Cells(b, 2)), Day(WorksheetFunction.EoMonth(v.Cells(b, 2), 0)))
        sat = sat + 1
        t
.Cells(sat, 5) = v.Cells(b, 1)
    If Month(v.Cells(b, 2)) <> 12 Then
        sat 
= sat + 1
        t
.Cells(sat, 1) = vtablo(a, 1)
        t.Cells(sat, 2) = DateSerial(Year(vtablo(a, 3)), Month(v.Cells(b, 2)), Day(WorksheetFunction.EoMonth(v.Cells(b, 2), 0))) + 1
        t
.Cells(sat, 3) = Format(vtablo(a, 3), "dd.mm.yyyy")
        t.Cells(sat, 4).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    End If
    End If
Next b
, a
MsgBox 
"...:İşlem Tammamlandı:..." & vbCrLf & vbCrLf & _
"                 Metehan8001 / Feyzullah", vbInformation + vbMsgBoxRtlReading, "www.ExcelDestek.Com"
End Sub
Kullanıcı avatarı
Feyzullah
Site Dostu
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 08:30
İleti: 720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#5)  hizmeteozel » 07 Ağu 2019 17:27

Feyzullah bey tam istediğim gibi olmuş elinize sağlık, çok teşekkür ederim.

Peki bunu bir adım ileri taşıyabilir miyiz? Yapılacak işlem ve koşullar aynı ancak bu sefer sabit bir tarihe göre işlem 3 ayrı sayfada yapılacak.

Excel dosyasını yeniden düzenleyip bu mesaja ekledim. Gönderdiğim bu dosyadaki hücre ve değer yerleşimleri tam üzerinde çalıştığım dosya ile aynı. Buna göre;

VERİ sayfasında herhangi bir Qx değerine isabet eden tarih, AKTIF isimli sayfanın (C2) hücresindeki tarihten küçükse BILINEN,

VERİ sayfasında herhangi bir Qx değerine isabet eden tarih aynı sayfanın (B11) hücresindeki tarihten büyükse PASIF,

VERİ sayfasında herhangi bir Qx değerine isabet eden tarih aynı sayfanın (B11) hücresindeki tarihten küçük fakat AKTIF isimli sayfanın (C2) hücresindeki tarihten büyükse AKTIF sayfasında işlem yapılsın istiyorum.

Olursa çok makbule geçer olmazsa canınız sağolsun. Teşekkür ederim tekrar.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hizmeteozel
Yeni Başlamış
 
Kayıt: 14 Eyl 2018 09:28
Meslek: Avukat
Yaş: 44
İleti: 15
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Manisa

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#6)  Feyzullah » 08 Ağu 2019 16:18

Veri sayfasındaki tarihlerin satırı değişken olmaması gerekiyor belli bir standartta olması gerek. Neden B11 hücresi, neye göre B11 hücresine bakarak işlem yapacağız.

Ayrıca bu çalışmanın son halini manuel hazırlayıp ekler misin ? Sonuç nasıl olmalı, daha iyi anlamak için.
Kullanıcı avatarı
Feyzullah
Site Dostu
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 08:30
İleti: 720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#7)  hizmeteozel » 08 Ağu 2019 17:14

Feyzullah bey eğer Qx tarihlerinin değerlerinin aynı sütunda (ilk örnekte olduğu gibi) olması gerekiyor ise her ne kadar VERİ sayfasında yerleşim son dosyadaki gibi olsa da bu sorunu şöyle çözebiliriz sanırım. FAKE isimli yeni bir sayfa ekledim ve Q ve Qx değerleri için tarih verisini yerleşim sayfasından tek sütuna (B sütunu) bağladım. Böylece görünüm ilk dosyadaki VERİ sayfası gibi oldu, sadece sayfa ismi FAKE olarak değişti. Son verdiğiniz koda göre burada sorun kalmamış oluyor.

O halde eski koda ek olarak sadece eski VERİ sayfasının karşılığı olan FAKE sayfasında Q değerinin (B2) tarihine göre Qx değerinin işlem yapacağı sayfalar değişti. Q ve Qx değerlerine atanan tarihler değişken, sabit değil. Bu sebeple Q değeri için gösterilen tarih ana tarih olarak ele alınıp Qx değerlerine atanan tarihler ilgili oldukları sayfalarda parçalama, boşluk eklenme ve teselsül etme şeklinde işlem yapmalı. Temelde son yazdığınız kod ile aynı şeyi istiyorum ama sadece Q değeri ve buna ilave olunan ana bir tarih var ve bu tarih Qx değerine atanan tarihin hangi sayfada böl parçala devam ettir işlemini yapacağını belirliyor.

FAKE sayfasında herhangi bir Qx değerine isabet eden tarih, AKTIF isimli sayfanın (C2) hücresindeki tarihten küçükse BILINEN,

FAKE sayfasında herhangi bir Qx değerine isabet eden tarih FAKE sayfasının (B2) hücresindeki tarihten büyükse PASIF,

VERİ sayfasında herhangi bir Qx değerine isabet eden tarih FAKE sayfasının (B2) hücresindeki tarihten küçük fakat AKTIF isimli sayfanın (C2) hücresindeki tarihten büyükse AKTIF sayfasında işlem yapılsın istiyorum.

İşlem yapılmış gibi olan dosyayı da ekliyorum. Teşekkür ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hizmeteozel
Yeni Başlamış
 
Kayıt: 14 Eyl 2018 09:28
Meslek: Avukat
Yaş: 44
İleti: 15
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Manisa

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#8)  Feyzullah » 09 Ağu 2019 05:45

Sayfa Sayfa
Kod: Tümünü seç
Sub exceldestek()
Dim b As Worksheet: Set b = Worksheets("BILINEN")
Dim a As Worksheet: Set a = Worksheets("AKTIF")
Dim p As Worksheet: Set p = Worksheets("AKTIF")
Dim f As Worksheet: Set f = Worksheets("FAKE")
''BILINEN
son 
= b.Cells(b.Rows.Count, 2).End(xlUp).Row: sat = 1
veri 
= b.Range("A2:J" & son): b.Range("A2:J" & son + 2).ClearContents
For c 
= 1 To son - 1
sat 
= sat + 1
    b
.Cells(sat, 1).Resize(1, 5) = Array(veri(c, 1), veri(c, 2), veri(c, 3), veri(c, 4), veri(c, 5))
    b.Cells(sat, 6).Resize(1, 5) = Array(veri(c, 6), veri(c, 7), veri(c, 8), veri(c, 9), veri(c, 10))
    b.Cells(sat, 5).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
If CDate(veri(c, 3)) < CDate(a.Cells(2, 3)) Then
 For d 
= 2 To f.Cells(f.Rows.Count, 2).End(xlUp).Row
     If Year
(veri(c, 3)) = Year(f.Cells(d, 2)) Then
        b
.Cells(sat, 4) = DateSerial(Year(veri(c, 3)), Month(f.Cells(d, 2)), Day(WorksheetFunction.EoMonth(f.Cells(d, 2), 0)))
        sat = sat + 1
        b
.Cells(sat, 10) = f.Cells(d, 1)
    If Month(f.Cells(d, 2)) <> 12 Then
        sat 
= sat + 1
        b
.Cells(sat, 2) = veri(c, 2)
        b.Cells(sat, 3) = DateSerial(Year(veri(c, 3)), Month(f.Cells(d, 2)), Day(WorksheetFunction.EoMonth(f.Cells(d, 2), 0))) + 1
        b
.Cells(sat, 4) = Format(veri(c, 4), "dd.mm.yyyy")
        b.Cells(sat, 5).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    End If
    End If
 Next d
End If
Next c

''aktif
son 
= a.Cells(a.Rows.Count, 2).End(xlUp).Row: sat = 1
veri 
= a.Range("A2:J" & son): a.Range("A2:J" & son + 2).ClearContents
For c 
= 1 To son - 1
sat 
= sat + 1
    a
.Cells(sat, 1).Resize(1, 5) = Array(veri(c, 1), veri(c, 2), veri(c, 3), veri(c, 4), veri(c, 5))
    a.Cells(sat, 6).Resize(1, 5) = Array(veri(c, 6), veri(c, 7), veri(c, 8), veri(c, 9), veri(c, 10))
    a.Cells(sat, 5).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
If Year(CDate(veri(c, 3))) < Year(CDate(f.Cells(2, 2))) And CDate(veri(c, 3)) > CDate(a.Cells(2, 3)) Then
 For d 
= 3 To f.Cells(f.Rows.Count, 2).End(xlUp).Row
     If Year
(veri(c, 3)) = Year(f.Cells(d, 2)) Then
        a
.Cells(sat, 4) = DateSerial(Year(veri(c, 3)), Month(f.Cells(d, 2)), Day(WorksheetFunction.EoMonth(f.Cells(d, 2), 0)))
        sat = sat + 1
        a
.Cells(sat, 10) = f.Cells(d, 1)
    If Month(f.Cells(d, 2)) <> 12 Then
        sat 
= sat + 1
        a
.Cells(sat, 2) = veri(c, 2)
        a.Cells(sat, 3) = DateSerial(Year(veri(c, 3)), Month(f.Cells(d, 2)), Day(WorksheetFunction.EoMonth(f.Cells(d, 2), 0))) + 1
        a
.Cells(sat, 4) = Format(veri(c, 4), "dd.mm.yyyy")
        a.Cells(sat, 5).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    End If
    End If
 Next d
End If
Next c

''PASİF
son 
= p.Cells(a.Rows.Count, 2).End(xlUp).Row: sat = 1
veri 
= p.Range("A2:J" & son): p.Range("A2:J" & son + 2).ClearContents
For c 
= 1 To son - 1
sat 
= sat + 1
    p
.Cells(sat, 1).Resize(1, 5) = Array(veri(c, 1), veri(c, 2), veri(c, 3), veri(c, 4), veri(c, 5))
    p.Cells(sat, 6).Resize(1, 5) = Array(veri(c, 6), veri(c, 7), veri(c, 8), veri(c, 9), veri(c, 10))
    p.Cells(sat, 5).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
If Year(CDate(veri(c, 3))) >= Year(CDate(f.Cells(2, 2))) Then
 For d 
= 3 To f.Cells(f.Rows.Count, 2).End(xlUp).Row
     If Year
(veri(c, 3)) = Year(f.Cells(d, 2)) Then
        p
.Cells(sat, 4) = DateSerial(Year(veri(c, 3)), Month(f.Cells(d, 2)), Day(WorksheetFunction.EoMonth(f.Cells(d, 2), 0)))
        sat = sat + 1
        p
.Cells(sat, 10) = f.Cells(d, 1)
    If Month(f.Cells(d, 2)) <> 12 Then
        sat 
= sat + 1
        p
.Cells(sat, 2) = veri(c, 2)
        p.Cells(sat, 3) = DateSerial(Year(veri(c, 3)), Month(f.Cells(d, 2)), Day(WorksheetFunction.EoMonth(f.Cells(d, 2), 0))) + 1
        p
.Cells(sat, 4) = Format(veri(c, 4), "dd.mm.yyyy")
        p.Cells(sat, 5).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    End If
    End If
 Next d
End If
Next c
End Sub


Kısaltılmış..
Kod: Tümünü seç
Sub excelDestek80()
sYF = Array("BILINEN", "AKTIF", "PASIF")
Dim f As Worksheet: Set f = Worksheets("FAKE")
Dim a As Worksheet: Set a = Worksheets("AKTIF")

For s = LBound(sYF) To UBound(sYF)

    son = Sheets(sYF(s)).Cells(Sheets(sYF(s)).Rows.Count, 2).End(xlUp).Row: sat = 1
    veri 
= Sheets(sYF(s)).Range("A2:J" & son): Sheets(sYF(s)).Range("A2:J" & son + 2).ClearContents
    
    For c 
= 1 To son - 1
sat 
= sat + 1
    Sheets
(sYF(s)).Cells(sat, 1).Resize(1, 5) = Array(veri(c, 1), veri(c, 2), veri(c, 3), veri(c, 4), veri(c, 5))
    Sheets(sYF(s)).Cells(sat, 6).Resize(1, 5) = Array(veri(c, 6), veri(c, 7), veri(c, 8), veri(c, 9), veri(c, 10))
    Sheets(sYF(s)).Cells(sat, 5).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    
If CDate
(veri(c, 3)) < CDate(a.Cells(2, 3)) And s = 0 Then
GoTo 10
ElseIf Year
(CDate(veri(c, 3))) < Year(CDate(f.Cells(2, 2))) And CDate(veri(c, 3)) > CDate(a.Cells(2, 3)) And s = 1 Then
GoTo 10
ElseIf Year
(CDate(veri(c, 3))) >= Year(CDate(f.Cells(2, 2))) And s = 2 Then
GoTo 10
10
:
 If s = 0 Then Started = 2
 If s 
<> 0 Then Started = 3
 For d 
= Started To f.Cells(f.Rows.Count, 2).End(xlUp).Row
     If Year
(veri(c, 3)) = Year(f.Cells(d, 2)) Then
        Sheets
(sYF(s)).Cells(sat, 4) = DateSerial(Year(veri(c, 3)), Month(f.Cells(d, 2)), Day(WorksheetFunction.EoMonth(f.Cells(d, 2), 0)))
        sat = sat + 1
        Sheets
(sYF(s)).Cells(sat, 10) = f.Cells(d, 1)
    If Month(f.Cells(d, 2)) <> 12 Then
        sat 
= sat + 1
        Sheets
(sYF(s)).Cells(sat, 2) = veri(c, 2)
        Sheets(sYF(s)).Cells(sat, 3) = DateSerial(Year(veri(c, 3)), Month(f.Cells(d, 2)), Day(WorksheetFunction.EoMonth(f.Cells(d, 2), 0))) + 1
        Sheets
(sYF(s)).Cells(sat, 4) = Format(veri(c, 4), "dd.mm.yyyy")
        Sheets(sYF(s)).Cells(sat, 5).FormulaR1C1 = "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    End If
    End If
 Next d
End If
Next c

Next s
End Sub
Kullanıcı avatarı
Feyzullah
Site Dostu
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 08:30
İleti: 720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#9)  hizmeteozel » 09 Ağu 2019 09:54

Feyzullah bey,

Diğeri aksıyor ama kısaltılmış kod tam da istediğimi yapıyor. Sadece konu başında ilk mesajımda yer alan ve önceki kod buna uygun yazılan bir hususu bu son kodda da yapabilirseniz size daha fazla rahatsızlık vermem :)

Qx değerine atanmış tarihlerde gün değeri 15'in altında ise bir önceki ayın son günü, 15 ve üstünde ise içinde bulunulan ayın son gününden bölme yapılmalı. Mesela örnek dosyada Q1 20.06.2016 iken Q2 10.11.2018. Bu durumda ilgili oldukları sayfada bölünme;

Q1 için 01.01.2016 - 30.06.2016 devamı boşluk sonra 01.07.2016....
Q2 için 01.01.2018 - 31.10.2018 devamı boşluk 01.11.2018....

Bunu da kısaltılmış koda eklerseniz problemim komple çözülmüş olur. Bu arada bu işlerden çok anlamamakla beraber vba kodlama meselesini anlamak adına sağda solda gördüğüm örnek kodları incelemeye çalışıyorum ve çok temiz kod yazdığınızı düşünüyorum. Ellerinize sağlık. Verdiğim zahmet dolayısı ile kusuruma bakmayın.
Kullanıcı avatarı
hizmeteozel
Yeni Başlamış
 
Kayıt: 14 Eyl 2018 09:28
Meslek: Avukat
Yaş: 44
İleti: 15
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Manisa

Cevap: Veriye Bağlı Olarak Tarihi Teselsül Ettirmek

İleti#10)  Feyzullah » 10 Ağu 2019 00:50

Kod: Tümünü seç
Sub excelDestek80dd()
sYF = Array("BILINEN""AKTIF""PASIF")
Dim f As WorksheetSet f Worksheets("FAKE")
Dim a As WorksheetSet a Worksheets("AKTIF")

For 
LBound(sYFTo UBound(sYF)
    
son Sheets(sYF(s)).Cells(Sheets(sYF(s)).Rows.Count2).End(xlUp).Rowsat 1
    veri 
Sheets(sYF(s)).Range("A2:J" son): Sheets(sYF(s)).Range("A2:J" son 2).ClearContents
    
    
For 1 To son 1
sat 
sat 1
    Sheets
(sYF(s)).Cells(sat1).Resize(15) = Array(veri(c1), veri(c2), veri(c3), veri(c4), veri(c5))
    
Sheets(sYF(s)).Cells(sat6).Resize(15) = Array(veri(c6), veri(c7), veri(c8), veri(c9), veri(c10))
    
Sheets(sYF(s)).Cells(sat5).FormulaR1C1 "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    
If CDate(veri(c3)) < CDate(a.Cells(23)) And 0 Then
GoTo 10
ElseIf Year(CDate(veri(c3))) < Year(CDate(f.Cells(22))) And CDate(veri(c3)) > CDate(a.Cells(23)) And 1 Then
GoTo 10
ElseIf Year(CDate(veri(c3))) >= Year(CDate(f.Cells(22))) And 2 Then
GoTo 10
10
:
 If 
0 Then Started 2
 
If <> 0 Then Started 3
 
For Started To f.Cells(f.Rows.Count2).End(xlUp).Row
     
If Year(veri(c3)) = Year(f.Cells(d2)) Then
        
If Day(f.Cells(d2)) < 15 Then
        Sheets
(sYF(s)).Cells(sat4) = DateSerial(Year(veri(c3)), Month(f.Cells(d2)) - 1Day(WorksheetFunction.EoMonth(f.Cells(d2), 0)))
        Else
        
Sheets(sYF(s)).Cells(sat4) = DateSerial(Year(veri(c3)), Month(f.Cells(d2)), Day(WorksheetFunction.EoMonth(f.Cells(d2), 0)))
        
End If
    
sat sat 1
    Sheets
(sYF(s)).Cells(sat10) = f.Cells(d1)
    If 
Month(f.Cells(d2)) <> 12 Then
    sat 
sat 1
    Sheets
(sYF(s)).Cells(sat2) = veri(c2)
        If 
Day(f.Cells(d2)) < 15 Then
        Sheets
(sYF(s)).Cells(sat3) = DateSerial(Year(veri(c3)), Month(f.Cells(d2)) - 1Day(WorksheetFunction.EoMonth(f.Cells(d2), 0))) + 1
        Sheets
(sYF(s)).Cells(sat4) = DateSerial(Year(veri(c4)), Month(veri(c4)) - 1Day(veri(c4)))
        Else
        
Sheets(sYF(s)).Cells(sat3) = DateSerial(Year(veri(c3)), Month(f.Cells(d2)), Day(WorksheetFunction.EoMonth(f.Cells(d2), 0))) + 1
        Sheets
(sYF(s)).Cells(sat4) = Format(veri(c4), "dd.mm.yyyy")
        
End If
    
Sheets(sYF(s)).Cells(sat5).FormulaR1C1 "=DATEDIF(RC[-2],RC[-1],""m"")+1"
    
End If
    
End If
 
Next d
End 
If
Next c
Next s
End Sub
Kullanıcı avatarı
Feyzullah
Site Dostu
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 08:30
İleti: 720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE


Forum Diğer Excel İşlemleri

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

cron
Bumerang - Yazarkafe