belirlenen tarihler arasını otomatik doldurma

av.akpinar · 29 Temmuz 2021

YUSUF44' Alıntı:
Bu sorunuz bu konu başlığının devamı mı yoksa ayrı bir konu mu?

devamı üstat yine tarihler arasını otomatik doldurma ama belli yıla kadar 7. ayda devrediyor
açıklama tabloda

YUSUF44 · 29 Temmuz 2021

Yani sormak istediğim konunun başından beri sormak istediğiniz konu bu mudur yoksa ilk soru farklı, bu soru farklı konuyla mı ilgili?

av.akpinar · 29 Temmuz 2021

YUSUF44' Alıntı:
Yani sormak istediğim konunun başından beri sormak istediğiniz konu bu mudur yoksa ilk soru farklı, bu soru farklı konuyla mı ilgili?

Üstat baştaki farklı idi bu farklı

YUSUF44 · 30 Temmuz 2021

Tam anladığımdan emin değilim ancak aşağıdaki kodları bir modüle kopyalayıp deneyin:. Kodun düzgün çalışmaması için veri sayfasında C sütununda örneğinizdeki gibi boş hücrelerde tarih verisi olmamalıdır. Kod C sütunundaki tarihlere göre işlem yapmaktadır. Eğer o sütunda boş görünen hücrelerde tarih varsa istediğiniz sonucu vermeyebilir (ya da verebilir):

PHP:

Sub tarihler()
Set s1 = Sheets("veri")
Set s2 = Sheets("veri 2")
Set s3 = Sheets("işlem")

sonC = s1.Cells(Rows.Count, "C").End(3).Row
sonA = s2.Cells(Rows.Count, "A").End(3).Row
eskiA = s3.Cells(Rows.Count, "A").End(3).Row
eskiF = s3.Cells(Rows.Count, "F").End(3).Row

If eskiA > 3 Then s3.Range("A4:D" & eskiA).Clear

s3.Range("F1:F" & eskiF).ClearContents
s3.[F1] = "Dönemler"
a = 2
For i = 2 To sonC
    If IsDate(s1.Cells(i, "C")) Then
        s3.Cells(a, "F") = s1.Cells(i, "C")
        a = a + 1
    End If
Next

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select distinct F1 from [veri 2$A2:A" & sonA & "] where F1<" & s3.Cells(a - 1, "F") * 1
Set rs = con.Execute(sorgu)

s3.Cells(a, "F").CopyFromRecordset rs

sonF = s3.Cells(Rows.Count, "F").End(3).Row



s3.Sort.SortFields.Clear
s3.Sort.SortFields.Add Key:=Range("F1:F" & sonF) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With s3.Sort
    .SetRange Range("F2:F" & sonF)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

s3.Range("$F$1:$F$" & sonF).RemoveDuplicates Columns:=1, Header:=xlYes

ensonF = s3.Cells(Rows.Count, "F").End(3).Row

For donem = 2 To ensonF - 1
    donemsonu = s3.Cells(donem + 1, "F")
10:
    yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
    If yeni = 4 Then
        s3.Cells(yeni, "A") = s3.Cells(donem, "F")
        s3.Cells(yeni, "B") = WorksheetFunction.Min(DateSerial(Year(s3.Cells(yeni, "A")), 12, 31), donemsonu)
    ElseIf s3.Cells(yeni - 1, "B") = s3.Cells(donem, "F") Then
        s3.Cells(yeni, "A") = s3.Cells(donem, "F")
        s3.Cells(yeni, "B") = WorksheetFunction.Min(DateSerial(Year(s3.Cells(yeni, "A")), 12, 31), donemsonu)
    Else
        s3.Cells(yeni, "A") = s3.Cells(yeni - 1, "B") + 1
        s3.Cells(yeni, "B") = WorksheetFunction.Min(DateSerial(Year(s3.Cells(yeni, "A")), 12, 31), donemsonu)
    End If
    s3.Cells(yeni, "C") = WorksheetFunction.YearFrac(s3.Cells(yeni, "A"), s3.Cells(yeni, "B"))
    s3.Cells(yeni, "D") = WorksheetFunction.VLookup(s3.Cells(yeni, "A"), s2.Range("A1:D" & sonA), 4, 1)
    If s3.Cells(yeni, "B") < donemsonu Then
        GoTo 10
    End If
Next

s3.Cells(yeni + 1, "A") = s3.Cells(ensonF, "F")
s3.Range("A4:B" & yeni + 1).NumberFormat = "dd/mm/yyyy"
s3.Range("A4:D" & yeni + 1).Borders.LineStyle = 1
s3.Range("F1:F" & ensonF).Clear
s3.Range("C4:C" & yeni + 1).NumberFormat = "#,##0.00"
s3.Range("D4:D" & yeni + 1).NumberFormat = "#,##0.00 $"

End Sub

av.akpinar · 30 Temmuz 2021

hocam c sütunundakiler etkilemiyor sıkıntı yok orda formülü uygulayınca aşağıdakinin aynısı çıksın istiyorum(önceki excel dosyasındaki 3.sayfanın aynısını vermesini istiyorum) bu formülü uyguladığımda istediğim sonuçtan farklı olan hususlar; başlangıç satırı13.06.2008 de başlayıp 01.07.2009 de bitmesi lazım orası farklı olmuş , son satır da 01.01.2020 de başlayıp 15.11.2020 de bitecek; aralarda da mesele sürekli 01.01.2015 den 01.01.2015e demiş bunları da çıkarmamız mümkün olursa eksiği kalmaz. size zahmet baya uzunmuş hocam. emeklerinize sağlık

YUSUF44 · 30 Temmuz 2021

Aşağıdaki kodu deneyiniz:

PHP:

Sub tarihler()
Set s1 = Sheets("veri")
Set s2 = Sheets("veri 2")
Set s3 = Sheets("işlem")

sonC = s1.Cells(Rows.Count, "C").End(3).Row
sonA = s2.Cells(Rows.Count, "A").End(3).Row
eskiA = s3.Cells(Rows.Count, "A").End(3).Row
eskiF = s3.Cells(Rows.Count, "F").End(3).Row

If eskiA > 3 Then s3.Range("A4:D" & eskiA).Clear

s3.Range("F1:F" & eskiF).ClearContents
s3.[F1] = "Dönemler"
a = 2
For i = 2 To sonC
    If IsDate(s1.Cells(i, "C")) Then
        s3.Cells(a, "F") = s1.Cells(i, "C")
        a = a + 1
    End If
Next

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select distinct F1 from [veri 2$A2:A" & sonA & "] where F1<" & s3.Cells(a - 1, "F") * 1 _
            & " and F1>" & s3.[F2] * 1
Set rs = con.Execute(sorgu)

s3.Cells(a, "F").CopyFromRecordset rs

sonF = s3.Cells(Rows.Count, "F").End(3).Row

s3.Sort.SortFields.Clear
s3.Sort.SortFields.Add Key:=Range("F1:F" & sonF) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With s3.Sort
    .SetRange Range("F2:F" & sonF)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

s3.Range("$F$1:$F$" & sonF).RemoveDuplicates Columns:=1, Header:=xlYes

ensonF = s3.Cells(Rows.Count, "F").End(3).Row

For donem = 2 To ensonF - 1
    donemsonu = s3.Cells(donem + 1, "F")
10:
    yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
    If yeni = 4 Then
        s3.Cells(yeni, "A") = s3.Cells(donem, "F")
        s3.Cells(yeni, "B") = WorksheetFunction.Min(DateSerial(Year(s3.Cells(yeni, "A")), 12, 31), donemsonu)
    ElseIf s3.Cells(yeni - 1, "B") = s3.Cells(donem, "F") Then
        s3.Cells(yeni, "A") = s3.Cells(donem, "F")
        s3.Cells(yeni, "B") = WorksheetFunction.Min(DateSerial(Year(s3.Cells(yeni, "A")), 12, 31), donemsonu)
    Else
        s3.Cells(yeni, "A") = s3.Cells(yeni - 1, "B") + 1
        s3.Cells(yeni, "B") = WorksheetFunction.Min(DateSerial(Year(s3.Cells(yeni, "A")), 12, 31), donemsonu)
    End If
    s3.Cells(yeni, "C") = WorksheetFunction.YearFrac(s3.Cells(yeni, "A"), s3.Cells(yeni, "B"))
    s3.Cells(yeni, "D") = WorksheetFunction.VLookup(s3.Cells(yeni, "A"), s2.Range("A1:D" & sonA), 4, 1)
    If s3.Cells(yeni, "B") < donemsonu Then
        GoTo 10
    End If
Next

s3.Range("A4:B" & yeni).NumberFormat = "dd/mm/yyyy"
s3.Range("A4:D" & yeni).Borders.LineStyle = 1
s3.Range("F1:F" & ensonF).Clear
s3.Range("C4:C" & yeni).NumberFormat = "#,##0.00"
s3.Range("D4:D" & yeni).NumberFormat = "#,##0.00 $"
s3.Range("A4:C" & yeni).HorizontalAlignment = xlCenter
s3.Range("A4:D" & yeni).VerticalAlignment = xlCenter
For m = yeni To 4 Step -1
    If s3.Cells(m, "A") = s3.Cells(m, "B") Then
        s3.Range("A" & m & ":D" & m).Delete Shift:=xlUp
    End If
Next
End Sub

av.akpinar · 31 Temmuz 2021

Üstat çok teşekkür ederim. işimi görecek hale getirdim bu formülle dediğiniz gibi; c sütununda başka tarih olması sıkıntı imiş gerçekten onu da ayrı bir sayfa yapıp bıraktım halloldu .
işlem sayfasındaki verileri başka yere çekerken 3.6.9.vd satırlar BAŞV sorunu veriyor. anlamadım ama halletmek bi kaç sn alıyor. manuellik çok az kısım kaldı. Emeğinize sağlık. Allah razı olsun sizden

av.akpinar · 31 Temmuz 2021

YUSUF44' Alıntı:

Aşağıdaki gibi deneyin:

PHP:

Sub tarihler()
sonA = Cells(Rows.Count, "A").End(3).Row
sonD = Cells(Rows.Count, "D").End(3).Row
If sonD > 1 Then Range("D2:E" & sonD).Clear

For donem = 2 To sonA - 1
    donemsonu = Cells(donem + 1, "A")
10:
    yeni = Cells(Rows.Count, "D").End(3).Row + 1
    If yeni = 2 Then
        Cells(yeni, "D") = Cells(donem, "A")
        Cells(yeni, "E") = WorksheetFunction.Min(DateSerial(Year(Cells(yeni, "D")), 12, 31), donemsonu)
    ElseIf Cells(yeni - 1, "E") = Cells(donem, "A") Then
        Cells(yeni, "D") = Cells(donem, "A")
        Cells(yeni, "E") = WorksheetFunction.Min(DateSerial(Year(Cells(yeni, "D")), 12, 31), donemsonu)
        Cells(yeni, "D").Interior.Color = vbYellow
    Else
        Cells(yeni, "D") = Cells(yeni - 1, "E") + 1
        Cells(yeni, "E") = WorksheetFunction.Min(DateSerial(Year(Cells(yeni, "D")), 12, 31), donemsonu)
    End If
    If Cells(yeni, "E") < donemsonu Then
        GoTo 10
    End If
Next
Cells(yeni + 1, "D") = Cells(sonA, "A")
Cells(yeni + 1, "D").Interior.Color = vbYellow
Range("D2:E" & yeni + 1).NumberFormat = "dd/mm/yyyy"
Range("D2:E" & yeni + 1).Borders.LineStyle = 1
End Sub

Üstat bu formülde D ve E hücresinin son satırları fazla aynı tarihi iki kere fazladan yazmış, iki satırın son hücrelerini silsek sorun bitecek, bunun için ek olarak d ve e sütununun son hücrelerinin içini silen bir makro yazmaya çalışıyorum:

Sub Düğme4_Tıklat()
son = Sheets("GELİR PAYLAŞTIRMA TABLOSU").Cells(Rows.Count, "D").End(3).Row
Sheets("GELİR PAYLAŞTIRMA TABLOSU").Range(Cells(son, "D"), Cells(son, "E")).ClearContents
End Sub

Çalışmıyor maalesef, böyle bir bu formüle sizin formüle eklemek mümkün mü ayrı bir düğme mi yapmalıyım, makroda bile manuelim(

YUSUF44 · 31 Temmuz 2021

av.akpinar' Alıntı:
Üstat bu formülde D ve E hücresinin son satırları fazla aynı tarihi iki kere fazladan yazmış, iki satırın son hücrelerini silsek sorun bitecek, bunun için ek olarak d ve e sütununun son hücrelerinin içini silen bir makro yazmaya çalışıyorum:

Sub Düğme4_Tıklat()
son = Sheets("GELİR PAYLAŞTIRMA TABLOSU").Cells(Rows.Count, "D").End(3).Row
Sheets("GELİR PAYLAŞTIRMA TABLOSU").Range(Cells(son, "D"), Cells(son, "E")).ClearContents
End Sub

Çalışmıyor maalesef, böyle bir bu formüle sizin formüle eklemek mümkün mü ayrı bir düğme mi yapmalıyım, makroda bile manuelim(

End sub satırından önce aşağıdaki satırları ekleyin:

PHP:

Cells(yeni + 1, "D").ClearContents
Cells(yeni, "E").ClearContents

YUSUF44 · 31 Temmuz 2021

av.akpinar' Alıntı:
Üstat çok teşekkür ederim. işimi görecek hale getirdim bu formülle dediğiniz gibi; c sütununda başka tarih olması sıkıntı imiş gerçekten onu da ayrı bir sayfa yapıp bıraktım halloldu .
işlem sayfasındaki verileri başka yere çekerken 3.6.9.vd satırlar BAŞV sorunu veriyor. anlamadım ama halletmek bi kaç sn alıyor. manuellik çok az kısım kaldı. Emeğinize sağlık. Allah razı olsun sizden

Verdiğim kodlarda formül yok, dolayısıyla BAŞV hatası vermesi imkansız. Sorununuzu anlamadım maalesef. Eğer sorunuzu tam olarak ne istediğinizi belirterek sorarsanız uyarlamak için fazla uğraşmazsınız. Örnek dosyanız ve sorunuz en son halde ne istediğinizi belirtecek şekilde olursa iyi olur.

av.akpinar · 31 Temmuz 2021

YUSUF44' Alıntı:
Verdiğim kodlarda formül yok, dolayısıyla BAŞV hatası vermesi imkansız. Sorununuzu anlamadım maalesef. Eğer sorunuzu tam olarak ne istediğinizi belirterek sorarsanız uyarlamak için fazla uğraşmazsınız. Örnek dosyanız ve sorunuz en son halde ne istediğinizi belirtecek şekilde olursa iyi olur.

Üstat tablonun en üstünden aşağı sürükle formülü yazdığım için sıkıntı olmuş, veri olmayan yerden veri almaya çalışmış, hallettim bu kısmı, Teşekkür ederim

av.akpinar · 31 Temmuz 2021

YUSUF44' Alıntı:
End sub satırından önce aşağıdaki satırları ekleyin:

PHP:

Cells(yeni + 1, "D").ClearContents Cells(yeni, "E").ClearContents

Üstat teşekkür ederim, ilk attığım tabloda kullandığım formül kusursuz şimdi, küçük bir detayı da bugün eklemem gerektiğini öğrendim aynı tabloda; a2:a8 deki tarihlerin önce küçükten büyüğe tarihsel sıralanmasını ardından o sıraya göre otomatik sıralaması lazımmış, küçükten büyüğe sıralamak için nasıl bir ekleme yapabiliriz

YUSUF44 · 31 Temmuz 2021

İkinci isteğiniz için verdiğim kodun aşağıdaki kısmı sıralamaya yarıyor. Biraz uğraşırsanız uyarlayabilirsiniz bence:

PHP:

s3.Sort.SortFields.Clear
s3.Sort.SortFields.Add Key:=Range("F1:F" & sonF) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With s3.Sort
    .SetRange Range("F2:F" & sonF)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

av.akpinar · 1 Ağustos 2021

YUSUF44' Alıntı:
İkinci isteğiniz için verdiğim kodun aşağıdaki kısmı sıralamaya yarıyor. Biraz uğraşırsanız uyarlayabilirsiniz bence:

PHP:

s3.Sort.SortFields.Clear s3.Sort.SortFields.Add Key:=Range("F1:F" & sonF) _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With s3.Sort .SetRange Range("F2:F" & sonF) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With

Tam uyarlayamadım ancak makro kaydet ile halloldu üstat, onu ekledim benzer bir formül, hallettim üstat çol teşekkür ederim emekleriniz için

YUSUF44 · 1 Ağustos 2021

av.akpinar' Alıntı:
Tam uyarlayamadım ancak makro kaydet ile halloldu üstat, onu ekledim benzer bir formül, hallettim üstat çol teşekkür ederim emekleriniz için

Aklın yolu bir, ben de makro kaydetle oluşturmuştum .

belirlenen tarihler arasını otomatik doldurma

av.akpinar

YUSUF44

Destek Ekibi

av.akpinar

YUSUF44

Destek Ekibi

av.akpinar

YUSUF44

Destek Ekibi

av.akpinar

av.akpinar

YUSUF44

Destek Ekibi

YUSUF44

Destek Ekibi

av.akpinar

av.akpinar

YUSUF44

Destek Ekibi

av.akpinar

YUSUF44

Destek Ekibi