İki Tarih Arası Döngü

ahmed_ummu · 25 Aralık 2022

İyi akşamlar arkadaşlar

Textbox15 ve Textbox16 ya iki tarih giriyorum ve döngünün başlangıç tarihi Teztbox15 deki tarih, Döngünün son değeri ise Textbox16'dan girilen tarih.

Tarihin ay adını sayfa1 "F" sütununun 5 satırından başlayarak, Tarihin yılını da "G" sütununa yazacak.

Textbox15 deki tarih 15.02.2022 Textbox16 daki tarih 15.11.2022 ise

F G
Şubat 2022
Mart 2022
Nisan 2022
Mayıs 2022
Haziran 2022
Temmuz 2022
Ağustos 2022
Eylül 2022
Ekim 2022
Kasım 2022

şeklinde sayfaya yazacak. Bulduğum örneklerden yapmaya çalıştım ama beceremedim. Yardımcı olursanız sevinirim.

dEdE · 25 Aralık 2022

Merhaba,
Örnek dosyanız olmadığı için biraz hayali oldu.

Kod:

Private Sub CommandButton1_Click()
    tx1 = CDate(TextBox15.Text)
    tx2 = CDate(TextBox16.Text)
    Sat = 5
        For i = 1 To DateDiff("m", tx1, tx2) + 1
            Cells(Sat, 6) = Format(DateAdd("m", i - 1, tx1), "mmmm")
            Cells(Sat, 7) = Format(DateAdd("m", i - 1, tx1), "yyyy")
            Sat = Sat + 1
        Next
End Sub

Necdet · 25 Aralık 2022

Merhaba,
Alternatif olsun.

Kod:

Private Sub CommandButton1_Click()

Dim sat As Integer

sat = DateDiff("m", TextBox15.Value, TextBox16.Value)

Sayfa1.Range("F5") = CDate(TextBox15.Value)
Sayfa1.Range("G5") = CDate(TextBox15.Value)

With Sayfa1.Range("F5:G" & sat + 5)
    .DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlMonth, Step:=1, Trend:=False
End With

Sayfa1.Range("F5:F" & sat + 5).NumberFormat = "mmmm"
Sayfa1.Range("G5:G" & sat + 5).NumberFormat = "yyyy"

End Sub

Korhan Ayhan · 26 Aralık 2022

Başka bir alternatif..

C++:

Option Explicit

Private Sub CommandButton1_Click()
    Dim Month_Difference As Integer
    Month_Difference = (Year(TextBox16) - Year(TextBox15)) * 12 + Month(TextBox16) - Month(TextBox15) + 1
    With Range("F5")
        .Resize(Rows.Count - 5).ClearContents
        .Resize(Month_Difference).Formula = "=TEXT(EOMONTH(" & CLng(CDate(TextBox15)) & ",ROW()-5),""aaaa"")"
        .Resize(Month_Difference).Value = .Resize(Month_Difference).Value
    End With
    With Range("G5")
        .Resize(Rows.Count - 5).ClearContents
        .Resize(Month_Difference).Formula = "=TEXT(EOMONTH(" & CLng(CDate(TextBox15)) & ",ROW()-5),""yyy"")"
        .Resize(Month_Difference).Value = .Resize(Month_Difference).Value
    End With
End Sub

ahmed_ummu · 26 Aralık 2022

dEdE' Alıntı:

Merhaba,
Örnek dosyanız olmadığı için biraz hayali oldu.

Kod:

Private Sub CommandButton1_Click()
    tx1 = CDate(TextBox15.Text)
    tx2 = CDate(TextBox16.Text)
    Sat = 5
        For i = 1 To DateDiff("m", tx1, tx2) + 1
            Cells(Sat, 6) = Format(DateAdd("m", i - 1, tx1), "mmmm")
            Cells(Sat, 7) = Format(DateAdd("m", i - 1, tx1), "yyyy")
            Sat = Sat + 1
        Next
End Sub

Çok teşekkürler sayın dEdE

Necdet' Alıntı:

Merhaba,
Alternatif olsun.

Kod:

Private Sub CommandButton1_Click()

Dim sat As Integer

sat = DateDiff("m", TextBox15.Value, TextBox16.Value)

Sayfa1.Range("F5") = CDate(TextBox15.Value)
Sayfa1.Range("G5") = CDate(TextBox15.Value)

With Sayfa1.Range("F5:G" & sat + 5)
    .DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlMonth, Step:=1, Trend:=False
End With

Sayfa1.Range("F5:F" & sat + 5).NumberFormat = "mmmm"
Sayfa1.Range("G5:G" & sat + 5).NumberFormat = "yyyy"

End Sub

Çok teşekkürler Necdet bey

ahmed_ummu · 26 Aralık 2022

Korhan Ayhan' Alıntı:

Başka bir alternatif..

C++:

Option Explicit

Private Sub CommandButton1_Click()
    Dim Month_Difference As Integer
    Month_Difference = (Year(TextBox16) - Year(TextBox15)) * 12 + Month(TextBox16) - Month(TextBox15) + 1
    With Range("F5")
        .Resize(Rows.Count - 5).ClearContents
        .Resize(Month_Difference).Formula = "=TEXT(EOMONTH(" & CLng(CDate(TextBox15)) & ",ROW()-5),""aaaa"")"
        .Resize(Month_Difference).Value = .Resize(Month_Difference).Value
    End With
    With Range("G5")
        .Resize(Rows.Count - 5).ClearContents
        .Resize(Month_Difference).Formula = "=TEXT(EOMONTH(" & CLng(CDate(TextBox15)) & ",ROW()-5),""yyy"")"
        .Resize(Month_Difference).Value = .Resize(Month_Difference).Value
    End With
End Sub

Çok teşekkürler Korhan bey

ahmed_ummu · 26 Aralık 2022

Merhaba arkadaşlar

Kusura bakmayın aynı konunun devamı ile ilgili bir soru daha soracağım. Ekte gönderdiğim örnek dosyada "ks" sayfasında "A" sütununda yıl, "B" sütununda Ay isimleri var. C-D-E ... sütunlarında bazı parametreler var. "ks" sayfasındaki verilerden Textbox1 ve Textbox2 den girilen tarihler aralığındaki verileri ÇÖB sayfasının "H" ve "I" sütunlarına nasıl yazdırabilirim. Örnekte yapmaya çalıştım ama herhangi bir hata vermiyor fakat yazdırma işleminide yapmıyor.

Mesela,
Textbox1 den 15.02.2021 tarihini girdim.
Textbox2 den de 15.05.2022 tarihini girdim.

"ks" sayfasından A sütununda 2021, B sütununda şubat satırının C sütunundaki veriyi "çöb" sayfasının "H" sütununa yazacak. Textbox2 den girilen tarihe kadar 2022 yılının Mayıs ayına kadar.

ahmed_ummu · 26 Aralık 2022

Aşağıdaki gibi de bir hata vermiyor ama işlemi de yapmıyor

Set sh1 = Sheets("çöb")
Set sh2 = Sheets("ks")
tx1 = CDate(TextBox1.Text)
tx2 = CDate(TextBox2.Text)
sat = 5
For i = 1 To DateDiff("m", tx1, tx2) + 1
sh1.Cells(sat, 6) = Format(DateAdd("m", i - 1, tx1), "mmmm")
sh1.Cells(sat, 7) = Format(DateAdd("m", i - 1, tx1), "yyyy")
t1 = sh1.Cells(sat, 6)
t2 = sh1.Cells(sat, 7)
If sh2.Cells(sat - 3, 1).Value = t2 And sh2.Cells(sat - 3, 1).Value = t1 Then
sh1.Cells(sat, 8).Value = sh2.Cells(sat, 1).Value
sh1.Cells(sat, 9).Value = sh2.Cells(sat, 2).Value
sat = sat + 1
End If
Next

ahmed_ummu · 26 Aralık 2022

Bu şekilde de olmadı. Yine hata vermiyor fakat yazdırma işlemini yapmıyor

Set sh1 = Sheets("çöb")
Set sh2 = Sheets("ks")
tx1 = CDate(TextBox1.Text)
tx2 = CDate(TextBox2.Text)
Sat = 5
For i = 1 To DateDiff("m", tx1, tx2) + 1
sh1.Cells(Sat, 6) = Format(DateAdd("m", i - 1, tx1), "mmmm")
sh1.Cells(Sat, 7) = Format(DateAdd("m", i - 1, tx1), "yyyy")
Sat = Sat + 1
Next

t1 = sh1.Cells(Sat, 7) = Format(DateAdd("m", i - 1, tx1), "yyyy")
t2 = sh1.Cells(Sat, 6) = Format(DateAdd("m", i - 1, tx1), "mmmm")
s = 5
For i = 2 To sh2.Cells(Rows.Count, 2).End(xlUp).Row
If sh2.Cells(i, 1).Value = t1 And sh2.Cells(i, 2).Value = t2 Then
sh1.Range("h" & s).Value = sh2.Cells(i, 3).Value
s = s + 1
End If
Next i

dEdE · 26 Aralık 2022

Merhaba,
Örnek dosyanızda aşağıdaki kodu dener misiniz?

Kod:

Private Sub CommandButton1_Click()
Set sh1 = Sheets("ÇÖB")
Set sh2 = Sheets("ks")
tx1 = CDate(TextBox1.Text) 'TextBox'un içeriği doğal olarak textdir. Bu satır TextBox'un içeriğini Tarihe dönüştürür.
AySay = DateDiff("m", tx1, tx2) 'İki tarih arasında kaç ay fark var.
myAy = Format(tx1, "mmmm") 'sayısal olan ay değerini metne çevirir.01-->Ocak gibi
myYl = Year(tx1) 'TextBox'daki tarihin sadece yıl kısmını alır.
    sh1.Range("F5:H" & sh1.Cells(Rows.Count, "H").End(3).Row) = "" 'F5:H son satırlar arasını temizler
    Set c = sh2.Range("A:A").Find(myYl, , xlValues) 'ks sayfasında A sütununda yılı bulur
        If Not c Is Nothing Then Sat1 = c.Row 'yılın bulunduğu satırı bulur
    Set d = sh2.Range("B" & Sat1 & ":B" & Sat1 + AySay).Find(myAy, , xlValues) 'yılın bulunduğu satırdan aşağıya doğru ayı bulur
        If Not d Is Nothing Then Sat2 = d.Row 'ayın bulunduğu satır numarasını bulur
    sh2.Range("A" & Sat2 & ":C" & Sat2 + AySay).Copy sh1.Range("F5") 'ks sayfasından A:C sütunlarındaki bulunan alanı ÇÖB sayfasına kopyalar
End Sub

ahmed_ummu · 26 Aralık 2022

dEdE' Alıntı:

Merhaba,
Örnek dosyanızda aşağıdaki kodu dener misiniz?

Kod:

Private Sub CommandButton1_Click()
Set sh1 = Sheets("ÇÖB")
Set sh2 = Sheets("ks")
tx1 = CDate(TextBox1.Text)
tx2 = CDate(TextBox2.Text)
AySay = DateDiff("m", tx1, tx2)
myAy = Format(tx1, "mmmm")
myYl = Year(tx1)
    Range("F5:H" & sh1.Cells(Rows.Count, "H").End(3).Row) = ""
    Set c = sh2.Range("A:A").Find(myYl, , xlValues)
        If Not c Is Nothing Then Sat1 = c.Row
    Set d = sh2.Range("B" & Sat1 & ":B" & Sat1 + AySay).Find(myAy, , xlValues)
        If Not d Is Nothing Then Sat2 = d.Row
    sh2.Range("A" & Sat2 & ":C" & Sat2 + AySay).Copy sh1.Range("F5")
End Sub

Çok teşekkürler sayın dEdE sorun çözüldü.

Ziynettin · 26 Aralık 2022

Alternatif

Kod:

Sub test()
    Set sh1 = Sheets("çöb")
    Set sh2 = Sheets("ks")
    
    Dim tx1 As Date, tx2 As Date, Tbl()
    tx1 = CDate(TextBox1.Text)
    tx2 = CDate(TextBox2.Text)
    t = DateDiff("m", tx1, tx2)
    
    Set dc = CreateObject("scripting.dictionary")

    For i = 0 To t
        trh = DateAdd("m", i, tx1)
        yil = CStr(Year(trh))
        ay = MonthName(Month(trh))
        dc(yil & "|" & ay) = yil & "|" & ay
    Next i
    
    
   son = sh2.Range("A" & Rows.Count).End(3).Row
   Tbl = sh2.Range("A1:I" & son).Value
  
   ReDim b(1 To UBound(Tbl) - 1, 1 To UBound(Tbl, 2))
    For i = 2 To UBound(Tbl)
    krt = CStr(Tbl(i, 1)) & "|" & Tbl(i, 2)
        If dc.exists(krt) Then
            say = say + 1
            For j = 1 To UBound(Tbl, 2)
                b(say, j) = Tbl(i, j)
            Next j
        End If
    Next i
 sh1.Range("F5:N" & Rows.Count).ClearContents
 sh1.[F5].Resize(say, UBound(Tbl, 2)) = b
End Sub

ahmed_ummu · 26 Aralık 2022

Ziynettin' Alıntı:

Alternatif

Kod:

Sub test()
    Set sh1 = Sheets("çöb")
    Set sh2 = Sheets("ks")
   
    Dim tx1 As Date, tx2 As Date, Tbl()
    tx1 = CDate(TextBox1.Text)
    tx2 = CDate(TextBox2.Text)
    t = DateDiff("m", tx1, tx2)
   
    Set dc = CreateObject("scripting.dictionary")

    For i = 0 To t
        trh = DateAdd("m", i, tx1)
        yil = CStr(Year(trh))
        ay = MonthName(Month(trh))
        dc(yil & "|" & ay) = yil & "|" & ay
    Next i
   
   
   son = sh2.Range("A" & Rows.Count).End(3).Row
   Tbl = sh2.Range("A1:I" & son).Value
 
   ReDim b(1 To UBound(Tbl) - 1, 1 To UBound(Tbl, 2))
    For i = 2 To UBound(Tbl)
    krt = CStr(Tbl(i, 1)) & "|" & Tbl(i, 2)
        If dc.exists(krt) Then
            say = say + 1
            For j = 1 To UBound(Tbl, 2)
                b(say, j) = Tbl(i, j)
            Next j
        End If
    Next i
sh1.Range("F5:N" & Rows.Count).ClearContents
sh1.[F5].Resize(say, UBound(Tbl, 2)) = b
End Sub

Çok teşekkürler Ziynettin bey.

ahmed_ummu · 26 Aralık 2022

Yardımlarınız için çok teşekkürler arkadaşlar. Devamını getiririm diye düşünüyordum ama yapamadım. Mesela sütunların devamına forma ekleyeceğim bazı textboxların değerini nasıl yazdırabilirim. Mesela Textbox 3'ün değerini "K" sütununa, Textbox4 n değerni "L" sütununa ... yazdırmak istersen nasıl yapmalıyım. Mesela ilk sıraya ay, yıl ve "ks" sayfasındaki parametreyi yazdığında yazacak.

2022 Şubat parametre, parametre, parametre, textbox3 değeri, textbox 4 değeri ...

Bir ricam olacak kod satırlarının karşısına hangi işlevi yaptığını açıklayan bir not yazabilirseniz heralde devamını getirebilirim.

sayın dEdE ve Ziynettin bey

dEdE · 26 Aralık 2022

İsteğiniz doğrultusunda #10 nu lu mesajı güncelledim.

ahmed_ummu · 26 Aralık 2022

dEdE' Alıntı:
İsteğiniz doğrultusunda #10 nu lu mesajı güncelledim.

Çok teşekkürler sayın dEdE

ahmed_ummu · 6 Ocak 2023

dEdE' Alıntı:

Merhaba,
Örnek dosyanızda aşağıdaki kodu dener misiniz?

Kod:

Private Sub CommandButton1_Click()
Set sh1 = Sheets("ÇÖB")
Set sh2 = Sheets("ks")
tx1 = CDate(TextBox1.Text) 'TextBox'un içeriği doğal olarak textdir. Bu satır TextBox'un içeriğini Tarihe dönüştürür.
AySay = DateDiff("m", tx1, tx2) 'İki tarih arasında kaç ay fark var.
myAy = Format(tx1, "mmmm") 'sayısal olan ay değerini metne çevirir.01-->Ocak gibi
myYl = Year(tx1) 'TextBox'daki tarihin sadece yıl kısmını alır.
    sh1.Range("F5:H" & sh1.Cells(Rows.Count, "H").End(3).Row) = "" 'F5:H son satırlar arasını temizler
    Set c = sh2.Range("A:A").Find(myYl, , xlValues) 'ks sayfasında A sütununda yılı bulur
        If Not c Is Nothing Then Sat1 = c.Row 'yılın bulunduğu satırı bulur
    Set d = sh2.Range("B" & Sat1 & ":B" & Sat1 + AySay).Find(myAy, , xlValues) 'yılın bulunduğu satırdan aşağıya doğru ayı bulur
        If Not d Is Nothing Then Sat2 = d.Row 'ayın bulunduğu satır numarasını bulur
    sh2.Range("A" & Sat2 & ":C" & Sat2 + AySay).Copy sh1.Range("F5") 'ks sayfasından A:C sütunlarındaki bulunan alanı ÇÖB sayfasına kopyalar
End Sub

Merhaba sayın dEdE. aşağıdaki kodda A:C (A-B ve C) sütunlarını ÇÖB sayfasına kopyalıyor. Sağolun siz göndermiştiniz bu kodu. A-B-E sütunlarını nasıl kopyalayabilirim. ":C" yi ":E" yaptım ama yine eskisi gibi sonuç verdi.

sh2.Range("A" & Sat2 & ":C" & Sat2 + AySay).Copy sh1.Range("F5")

Yardımcı olabilir misiniz.

İki Tarih Arası Döngü

ahmed_ummu

dEdE

Destek Ekibi

Necdet

Moderatör

Korhan Ayhan

Administrator

ahmed_ummu

ahmed_ummu

ahmed_ummu

Ekli dosyalar

ahmed_ummu

ahmed_ummu

dEdE

Destek Ekibi

ahmed_ummu

Ziynettin

Destek Ekibi

ahmed_ummu

ahmed_ummu

dEdE

Destek Ekibi

ahmed_ummu

ahmed_ummu