• DİKKAT

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

Aranan Tarihe En Yakın Tarihi Alttan ve Üstten bulmak

E

Ergün Güler

Katılım
5 Ocak 2009
Mesajlar
1,586
Excel Vers. ve Dili
2003 Türkçe
Aranan Tarihi En Satıra Eklemek

Selam,

ayfa1 üzerindeki butona tıkladığımda karşımıza çıkan form üzerinden herhangi bir tarih girip, girilen bu tarihin alttan ve üstten en yakın tarihi ve satırını bulmak istiyorum.
For-Next döngüsü olmadan nasıl yapabiliriz?
İyi çalışmalar.
 
Son düzenleme:
Selamlar,

Ergün bey tam sonuç değil ama aşağıdaki kodu kullanabilirsiniz. Siz biraz üzerinde çalışın. Eğer geliştiremezseniz sabah ben düzeltirim.

Kod: 
Private Sub CommandButton1_Click()
    If WorksheetFunction.CountIf(Range("A:A"), DTPicker1.Value) > 0 Then
        SATIR = WorksheetFunction.Match(CLng(DTPicker1.Value), Range("A:A"), 0)
        TextBox1 = SATIR
        TextBox2 = Format(Range("A" & SATIR), "dd.mm.yyyy")
        SATIR = Evaluate("=MIN(IF(A1:A1000>" & CLng(DTPicker1.Value) & ",ROW(A1:A1000)))")
        TextBox4 = SATIR
        TextBox3 = Format(Range("A" & SATIR), "dd.mm.yyyy")
    End If
End Sub
 
Selamlar,

Ergün bey sanırım siz inceleme fırsatı bulamadınız. Bende bu arada sanıyorum istediğiniz çözümü buldum. Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Private Sub CommandButton1_Click()
    Dim SATIR As Integer, TARİH As Date
 
    TextBox1 = "": TextBox2 = "": TextBox3 = "": TextBox4 = ""
 
    If WorksheetFunction.CountIf(Range("A:A"), DTPicker1.Value) > 0 Then
        SATIR = Evaluate("=MAX(IF(A1:A1000=" & CLng(DTPicker1.Value) & ",ROW(A1:A1000)))")
        If SATIR > 0 Then
            TextBox1 = SATIR
            TextBox2 = Format(Range("A" & SATIR), "dd.mm.yyyy")
        End If
 
        SATIR = Evaluate("=MIN(IF(A1:A1000>" & CLng(DTPicker1.Value) & ",ROW(A1:A1000)))")
        If SATIR > 0 Then
            TextBox4 = SATIR
            TextBox3 = Format(Range("A" & SATIR), "dd.mm.yyyy")
        End If
 
    Else
 
        TARİH = WorksheetFunction.VLookup(CLng(DTPicker1.Value), Range("A:A"), 1, 1)
        SATIR = WorksheetFunction.Match(CLng(TARİH), Range("A:A"), 0)
        If SATIR > 0 Then
            TextBox1 = SATIR
            TextBox2 = Format(Range("A" & SATIR), "dd.mm.yyyy")
        End If
 
        SATIR = Evaluate("=MIN(IF(A1:A1000>" & CLng(TARİH) & ",ROW(A1:A1000)))")
        If SATIR > 0 Then
            TextBox4 = SATIR
            TextBox3 = Format(Range("A" & SATIR), "dd.mm.yyyy")
        End If
    End If
End Sub
 
Selam,
Sayın Korhan Ayhan hocam, ilginiz ve yardımlarınız için çok teşekkür ederim.
Ancak, tam istediklerimi karşılamıyor.
mesela;
--01.12.2010 'dan daha büyük, tarih için hata veriyor. aslında alttan yakınlık olarak 01.12.2010 bulması gerekirdi.
--01.12.2010 ila 05.12.2010 arası girdiğimde üstten 1.satır, alttan 2. satır buluyor bu doğru.
--06.12.2010 girdiğimde üstten 4.satır, alttan 5. satır buluyor bu doğru.
--07.12.2010 ila 08.12.2010 arası girdiğimde üstten 2.satır, alttan 5. satır buluyor. aslında üstten 4.satır, alttan 5. satırı bulması gerekirdi.
--09.12.2010 girdiğimde üstten 7.satır, alttan 8. satır buluyor bu doğru.
--10.12.2010 ile 11.12.2010 girdiğimde üstten 5.satır, alttan 8. satır buluyor. aslında üstten 7.satır, alttan 8. satırı bulması gerekirdi.
--12.12.2010 girdiğimde üstten 8.satır buluyor bu doğru.

Aslında bu soruyu şunun için sormuştum;
Dtpicker ile girdiğim tarihi uygun olan yere satır olarak eklemek istiyordum. Sorum bu şekilde değildi ama, öğreneceğim yöntem ile bunu yapabilirim diye sordum.
Karışıklık benim soruyu ifade şeklinden kaynaklanıyor olabilir. Bu yüzden sizi yoruyorum ancak, sorumu yeniliyorum;
Dtpicker ile girdiğim tarihi uygun olan araya sokmak istiyorum. Yani satır olarak eklemek istiyorum. aradığım tarih var ise, aynı tarihlerin en altına eklemek istiyorum. Yok ise kendisinde küçük ile kendisinden büyük tarih arasına eklemek istiyorum.
yeni dosya üzerinden örnekler:
tarih 06.12.2010 ise, 5.satır ile 6.satır arasına
tarih 01.12.2010 ise, 2.satır ile 3.satır arasına
tarih 10.12.2010 ise, 8.satır ile 9.satır arasına

tarih en küçük ise en başa en büyük ise, en sona eklemek istiyorum.
örnekler:
tarih 30.11.2010 ise, 2.satıra
tarih 13.11.2010 ise, 9.satıra

yeni soruya göre dosyamı da güncellliyorum.
Şimdiden teşekkür ederim.
 
Son düzenleme:
Selamlar,

Evet ben sorunuzdan son mesajınızdaki gibi bir işlem yapacağınızı anlamamıştım. Neyse çok önemli değil. Beyin jimnastiği yapmış olduk. Son mesajınıza göre aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Private Sub CommandButton1_Click()
    Dim SATIR As Long
 
    If WorksheetFunction.CountIf(Range("A:A"), DTPicker1.Value) > 0 Then
        SATIR = Evaluate("=MAX(IF(A2:A65536=" & CLng(DTPicker1.Value) & ",ROW(A2:A65536)))")
        If SATIR > 0 Then
            Rows(SATIR + 1).Insert
            Cells(SATIR + 1, "A").NumberFormat = "m/d/yyyy"
            Cells(SATIR + 1, "A") = CLng(DTPicker1.Value)
            If IsNumeric(TextBox1) Then
                Cells(SATIR + 1, "B") = CDbl(TextBox1)
            Else
                Cells(SATIR + 1, "B") = TextBox1
            End If
            If IsNumeric(TextBox2) Then
                Cells(SATIR + 1, "C") = CDbl(TextBox2)
            Else
                Cells(SATIR + 1, "C") = TextBox2
            End If
        End If
 
   Else
 
        SATIR = Evaluate("=MIN(IF(A2:A65536>" & CLng(DTPicker1.Value) & ",ROW(A2:A65536)))")
        If SATIR > 0 Then
            Rows(SATIR).Insert
            Cells(SATIR, "A").NumberFormat = "m/d/yyyy"
            Cells(SATIR, "A") = CLng(DTPicker1.Value)
            If IsNumeric(TextBox1) Then
                Cells(SATIR, "B") = CDbl(TextBox1)
            Else
                Cells(SATIR, "B") = TextBox1
            End If
            If IsNumeric(TextBox2) Then
                Cells(SATIR, "C") = CDbl(TextBox2)
            Else
                Cells(SATIR, "C") = TextBox2
            End If
        End If
    End If
End Sub
 
Korhan Ayhan' Alıntı:
Selamlar,

Evet ben sorunuzdan son mesajınızdaki gibi bir işlem yapacağınızı anlamamıştım. Neyse çok önemli değil. Beyin jimnastiği yapmış olduk. Son mesajınıza göre aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Private Sub CommandButton1_Click()
    Dim SATIR As Long
 
    If WorksheetFunction.CountIf(Range("A:A"), DTPicker1.Value) > 0 Then
        SATIR = Evaluate("=MAX(IF(A2:A65536=" & CLng(DTPicker1.Value) & ",ROW(A2:A65536)))")
        If SATIR > 0 Then
            Rows(SATIR + 1).Insert
            Cells(SATIR + 1, "A").NumberFormat = "m/d/yyyy"
            Cells(SATIR + 1, "A") = CLng(DTPicker1.Value)
            If IsNumeric(TextBox1) Then
                Cells(SATIR + 1, "B") = CDbl(TextBox1)
            Else
                Cells(SATIR + 1, "B") = TextBox1
            End If
            If IsNumeric(TextBox2) Then
                Cells(SATIR + 1, "C") = CDbl(TextBox2)
            Else
                Cells(SATIR + 1, "C") = TextBox2
            End If
        End If
 
   Else
 
        SATIR = Evaluate("=MIN(IF(A2:A65536>" & CLng(DTPicker1.Value) & ",ROW(A2:A65536)))")
        If SATIR > 0 Then
            Rows(SATIR).Insert
            Cells(SATIR, "A").NumberFormat = "m/d/yyyy"
            Cells(SATIR, "A") = CLng(DTPicker1.Value)
            If IsNumeric(TextBox1) Then
                Cells(SATIR, "B") = CDbl(TextBox1)
            Else
                Cells(SATIR, "B") = TextBox1
            End If
            If IsNumeric(TextBox2) Then
                Cells(SATIR, "C") = CDbl(TextBox2)
            Else
                Cells(SATIR, "C") = TextBox2
            End If
        End If
    End If
End Sub
Genişletmek için tıkla ...

Selam Sayın Korhan Ayhan Hocam,

Çok Teşekkür ederim. Kodlar A sütunundaki ilk tarih ile son tarih arasında bir tarih girersem tam istediğim gibi çalışıyor. Ancak,
ilk tarihten önce veya sonra bir tarih girersem işlem yapmıyor.
Zannedersem ben yine size eksik anlatmış oldum. Kusura bakmayınız.
Affınıza sığınarak ben de bir çalışma bitirmiştim. Bu tam istediğim gibi yapıyor.

kodlar aşağıdaki gibidir.

Kod: 
Private Sub CommandButton1_Click()
Dim S1 As Worksheet
Set S1 = Sheets("sayfa1")
son = S1.Range("A65536").End(3).Row

rngA = "'" & S1.Name & "'!A2:A" & son
aranan = CLng(Me.DTPicker1.Value)

t_min = WorksheetFunction.Min(S1.Range("A2:A" & son))

If t_min = 0 Then
satır = 2
GoTo atla
End If

If aranan < t_min Then
satır = 2
Else
bulunan = Evaluate("=LOOKUP(" & aranan & ",(" & rngA & "),ROW(" & rngA & "))")
satır = bulunan + 1
End If
S1.Rows(satır).Insert Shift:=xlDown

atla:
S1.Cells(satır, "A") = aranan
S1.Cells(satır, "A").NumberFormat = "m/d/yyyy"
S1.Cells(satır, "B") = Me.TextBox1
S1.Cells(satır, "C") = Me.TextBox2

End Sub
 
Selamlar,

Hangi tarihi girdiğinizde hatalı sonuç aldınız. Bu tarihi nereye eklemesi gerekiyordu?
 
Korhan Ayhan' Alıntı:
Selamlar,

Hangi tarihi girdiğinizde hatalı sonuç aldınız. Bu tarihi nereye eklemesi gerekiyordu?
Genişletmek için tıkla ...

Selam Sayın Hocam, hadi ben gece çalışıyorum. Siz bu saatte uyumuyor musunuz? Maşallah.

Hocam, şimdi tekrar denedim.
A2'deki tarihten önce tarih girersem çalışıyor. Yani A2'de 01.12.2010 var. 30.11.2010 eklemek istersem A2'ye (en üste) ekliyor. Bunda sorun yok. Ama (dosyayı kaydetmeden önce çalışmamıştı. anlayamadım, ya da ben berecemedim)

Fakat, 30.12.2010 tarihin eklemek istesem hiçbir işlem yapmıyor.
bunu en son satırdaki 12.12.2010'un hemen altına eklemesi gerekiyordu.

İyi çalışmalar.
 
Selamlar,

Sanıyorum bu sefer daha sağlıklı çalışan bir kod oldu. Aşağıdaki kodu denermisiniz.

Kod: 
Private Sub CommandButton1_Click()
    Dim SATIR As Long
 
    If WorksheetFunction.CountA(Range("A2:A65536")) = 0 Then
        Cells(2, "A").NumberFormat = "m/d/yyyy"
        Cells(2, "A") = CLng(DTPicker1.Value)
        If IsNumeric(TextBox1) Then
            Cells(2, "B") = CDbl(TextBox1)
        Else
            Cells(2, "B") = TextBox1
        End If
        If IsNumeric(TextBox2) Then
            Cells(2, "C") = CDbl(TextBox2)
        Else
            Cells(2, "C") = TextBox2
        End If
    
    ElseIf WorksheetFunction.CountIf(Range("A:A"), DTPicker1.Value) > 0 Then
        SATIR = Evaluate("=MAX(IF(A2:A65536=" & CLng(DTPicker1.Value) & ",ROW(A2:A65536)))")
        If SATIR > 0 Then
            Rows(SATIR + 1).Insert
            Cells(SATIR + 1, "A").NumberFormat = "m/d/yyyy"
            Cells(SATIR + 1, "A") = CLng(DTPicker1.Value)
            If IsNumeric(TextBox1) Then
                Cells(SATIR + 1, "B") = CDbl(TextBox1)
            Else
                Cells(SATIR + 1, "B") = TextBox1
            End If
            If IsNumeric(TextBox2) Then
                Cells(SATIR + 1, "C") = CDbl(TextBox2)
            Else
                Cells(SATIR + 1, "C") = TextBox2
            End If
        End If
 
   Else
 
        If WorksheetFunction.Min(Range("A:A")) > CLng(DTPicker1.Value) Then
            SATIR = Evaluate("=MIN(IF(A2:A65536>" & CLng(DTPicker1.Value) & ",IF(A2:A65536<>"""",ROW(A2:A65536))))")
        Else
            SATIR = Evaluate("=MAX(IF(A2:A65536<" & CLng(DTPicker1.Value) & ",IF(A2:A65536<>"""",ROW(A2:A65536))))")
            If SATIR > 0 Then SATIR = SATIR + 1
        End If
        If SATIR > 0 Then
            Rows(SATIR).Insert
            Cells(SATIR, "A").NumberFormat = "m/d/yyyy"
            Cells(SATIR, "A") = CLng(DTPicker1.Value)
            If IsNumeric(TextBox1) Then
                Cells(SATIR, "B") = CDbl(TextBox1)
            Else
                Cells(SATIR, "B") = TextBox1
            End If
            If IsNumeric(TextBox2) Then
                Cells(SATIR, "C") = CDbl(TextBox2)
            Else
                Cells(SATIR, "C") = TextBox2
            End If
        End If
    End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst