Labelden Günlük Liste Almak

[nihatkr]

arkadaşlar. Excelde bir tablom var ve bu tabloda c1 sutununda tarihler d1 sutununda da rakamlar var. Bir user for oluşturudum ve bir label ekledim. yapmak istediğim şu. a1 hücresinde bugünün tarihi yazıyor.

Labeldeki kodda a1 hücresindeki tarihi gördüğünde c1 aynı tarihi bulup hem tarihi hemde d1 de yanında yazan rakamları liste halinde getirmesini istiyorum.

Bu konuda yardım edebilirmisiniz.

Teşekkürler

A1 = Bugün()

C1 D1
11.06.2008 230.068,61
10.06.2008 252.403,81
11.06.2008 243.286,04
12.06.2008 455.367,89
13.06.2008 177.902,63
13.06.2008 458.527,67
16.06.2008 328.759,47
11.06.2008 254.449,31
10.06.2008 484.669,43
09.06.2008 325.000,00
10.06.2008 325.000,00
12.06.2008 350.000,00

 

[Ayhan Ercan]

Selam, sorunuz net değil. mesela;
Liste olarak göstersin diyorsunuz. Liste nerde olacak? sayfadamı, userformda listboxmu?
İsterseniz sorunuzu örnek bir dosya ile destekleyiniz....

 

[nihatkr]

Selam, sorunuz net değil. mesela;
Liste olarak göstersin diyorsunuz. Liste nerde olacak? sayfadamı, userformda listboxmu?
İsterseniz sorunuzu örnek bir dosya ile destekleyiniz....

Sadece sunu ıstıyorum ben.
a1 de tarihim var ve altında da
c1 de tarihler d1 de rakamlar

label - demeyelim user form diyelim yada ne derseniz deyin ama olay şu.

a1 de yazan tarihi c1:c65536 ya kadar tarayıp bulduğu tarihleri ve yanındaki rakamları userforma (ben userformda label içerisinde listelenmiş şekilde gelmesini düşünmüştüm uyarı ekranı olarak) ama başka turlude olur gelsinde

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub Düğme3_Tıklat()
Dim k As Range, ilk As String, a As Long
Set s1 = Sheets("Sayfa1")
s1.ListBox1.Height = 301
s1.ListBox1.Clear
If Not IsDate(Range("A1").Value) Then Exit Sub
ReDim myarr(1 To 2, 1 To 1)
Set k = s1.Range("C1:C65536").Find(Range("A1").Value, , xlValues, xlWhole, , 1)
If Not k Is Nothing Then
    ilk = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 2, 1 To a)
        myarr(1, a) = Format(k.Value, "dd.mm.yyyy")
        myarr(2, a) = k.Offset(0, 1).Value
        Set k = s1.Range("C1:C65536").FindNext(k)
    Loop While ilk <> k.Address And Not k Is Nothing
    s1.ListBox1.Column = myarr
End If
Erase myarr
Set s1 = Nothing
Set k = Nothing

End Sub

 

[nihatkr]

Ekli dosyayı inceleyiniz.

Sub Düğme3_Tıklat()
Dim k As Range, ilk As String, a As Long
Set s1 = Sheets("Sayfa1")
s1.ListBox1.Height = 301
s1.ListBox1.Clear
If Not IsDate(Range("A1").Value) Then Exit Sub
ReDim myarr(1 To 2, 1 To 1)
Set k = s1.Range("C1:C65536").Find(Range("A1").Value, , xlValues, xlWhole, , 1)
If Not k Is Nothing Then
    ilk = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 2, 1 To a)
        myarr(1, a) = Format(k.Value, "dd.mm.yyyy")
        myarr(2, a) = k.Offset(0, 1).Value
        Set k = s1.Range("C1:C65536").FindNext(k)
    Loop While ilk <> k.Address And Not k Is Nothing
    s1.ListBox1.Column = myarr
End If
Erase myarr
Set s1 = Nothing
Set k = Nothing

End Sub

Hocam teşekkür ediyorum. elinize sağlık. İstediğim budur, tek farkla.
Aynı dizayn ve şekilde, düğme tıklaması olmadan ve tarihi gördüğü anda otomatik açılan user form olarak.

Saygılar.

 

[Orion1]

Hocam teşekkür ediyorum. elinize sağlık. İstediğim budur, tek farkla.
Aynı dizayn ve şekilde, düğme tıklaması olmadan ve tarihi gördüğü anda otomatik açılan user form olarak.

Saygılar.

4 numaralı mesajdan indirebilirsiniz.

 

[nihatkr]

Teşekkürler hocam. Ben bunu artık kendi userformumua uydurmaya calısırım. Ekranda görünmeyecek tarih değiştiğinde tarih varsa açılcak form halıne getırırım. Teşekkürler

 

[Orion1]

Teşekkürler hocam. Ben bunu artık kendi userformumua uydurmaya calısırım. Ekranda görünmeyecek tarih değiştiğinde tarih varsa açılcak form halıne getırırım. Teşekkürler

İstediğiniz şekilde dosya ekte.

 

[nihatkr]

Hocam budur işte. Teşekkür ederim. Bende yapmıştım ama açılışı yapamamıştım. Teşekkürler.

 

[Orion1]

Hocam budur işte. Teşekkür ederim. Bende yapmıştım ama açılışı yapamamıştım. Teşekkürler.

Rica ederim.
İyi çalışmalar.