Class Module uygulaması

[Barons]

Merhaba
Ekteki dosyada daha önce forumda yapılmış bir dosya var.Bu dosyada yıl ve aylara göre tutarları atamak istiyorum.
Açıklamalar dosyadadır.


yardımlarınız için teşekkürler

 

[Orion1]

Tutar değerleri nereye gelecek?
Bir kaç tanede veri girererk açıklamsınla beraBER dosyayı yollayın

 

[Barons]

merhaba
ilginiz için teşekkürler Evran Hocam,
dosyada 2009 için olması gereken değerleri girdim ancak 2010 için nasıl yapılabilir onu bende bilemiyorum.Yada şimdilik sadece 1 yıl için geçerli yani sadece ayla endeksli bir şeyde olabilir.

 

[Orion1]

Userform açılınca sayfadaki girdiğiniz değerler siliniyor.Ayrıca sorduğum soruya hala yanıt alabilmiş değilim.Veriler nerde gösterilecek.Userformdamı sayfadmı sayfada ise neresinde yok userformda ise userforma nesne ekleyin orada ghangi nesneler olduğunu söyleyin.Yani soruya cevap verebilmek için gördüğünüzgibi 40 takla atıyoruz.Bırakıp gidicem şimdi ,ama bulaştım bir kere.

 

[Barons]

merhaba
veriler userformda gözükmeyecek..sayfadaki tabloda gösterilecek.
2005 yılında forumdan bir örnek buldum...aynen bu ekteki örnekte olduğu gibi olmasına uğraşıyorum.
Aylar butonuna basarsanız veriler yani tablo temizleniyor ve daha sonra checkboxlara tıklanınca veriler dolmaya başlıyor.Çokda görsel bir uygulama.


sabrınız için teşekkürler

 

[Barons]

Sn.Evren Hocam

Yardımlarınızı bekliyorum.

 

[Orion1]

Dosyanız ektedir.

Public WithEvents Check As MSForms.CheckBox
Private Sub Check_Click()
Dim sut As Byte, i As Long, k As Range, adr As String
sut = Replace(Check.Name, "CheckBox", "")
If Check.Value = False Then
    Range(Cells(5, sut + 2), Cells(65536, sut + 2)).ClearContents
    Else
    For i = 5 To Cells(65536, "B").End(xlUp).Row
        Set k = Sheets("Hatirlat").Range("F2:F65536").Find(Cells(i, "B").Value _
        , , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                If CStr(Sheets("Hatirlat").Cells(k.Row, "H").Value) = Left(Range("A3").Value, 4) _
                And UCase(Replace(Replace(Sheets("Hatirlat").Cells(k.Row, "I").Value, "ı", "I"), "i", "İ")) _
                = Replace(Replace(Check.Tag, "i", "İ"), "ı", "I") Then
                    Cells(i, sut + 2).Value = Cells(i, sut + 2).Value + Sheets("Hatirlat").Cells(k.Row, "C").Value
                End If
                Set k = Sheets("Hatirlat").Range("F2:F65536").FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
    Next i
End If

End Sub

 

[Barons]

Hocam süpersin...eline sağlık..yıllarda ayarlanmış harika...çok teşekkürler

 

[Orion1]

Hocam süpersin...eline sağlık..yıllarda ayarlanmış harika...çok teşekkürler

Rica ederim.
İyi çalışmalar.

 

[Orion1]

Merak ettimde,
Niye TAKIM ELBİSE,ile SSK tiplerine son karakterlerine bir boşluk eklediniz.
Daha sonra bu size sorun yaratabilri.Bunu anlamıyorum.çBazı arkadaşlar değerlerin sonuna nedense bir boşluk karakteri koyuyorlar.Sonra sorgulam yaparkende niye bulamıyor aradığımı diye yakınıyorlar.Bulamaz tabii.Aradağı şey le arana şeyler farklı farklı şeyler.Birisinin sonunda boşluk karakteri var birisinin sonunda yok.O sondaki boşluk karakterini görmüyor ya zannediyor ki ikside ayni.
Bende hatırlatması.Bu mesajı okuyan diğer arkadaşlarda bu konuya dikkat ederlerse iyi olur.

 

[Barons]

Evet haklısınız hocam, ancak dosya alıntı olup,uyarınız için teşekkürler

 

[Barons]

Sn.Evren Hocam
Dosyadaki userforma bazı ilaveler yaptım.(userformdan yıl seçimi,checkboxların hepsinin seçilmesi veya tersi gibi.)
birde durum kısmındaki yapıldı,yapılmadı şeklinde ilave yapmam gerekiyor.Dosyada ne demek istediğimi anlayacaksınız.
(Aslında hatırlatma tarihleride olabilse süper ama onun tabloki pozisyonunu yapamadım..)
çok teşekkürler

 

[Orion1]

Dosyanız ektedir.

Public WithEvents Check As MSForms.CheckBox
Private Sub Check_Click()
Dim sut As Byte, i As Long, k As Range, adr As String
Dim yapildi As String
sut = Replace(Check.Name, "CheckBox", "")
If Check.Value = False Then
    Range(Cells(5, sut + 2), Cells(65536, sut + 2)).ClearContents
    Else
    For i = 5 To Cells(65536, "B").End(xlUp).Row
        Set k = Sheets("Hatirlat").Range("F2:F65536").Find(Cells(i, "B").Value _
        , , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                If CStr(Sheets("Hatirlat").Cells(k.Row, "H").Value) = Left(Range("A3").Value, 4) _
                And UCase(Replace(Replace(Sheets("Hatirlat").Cells(k.Row, "I").Value, "ı", "I"), "i", "İ")) _
                = Replace(Replace(Check.Tag, "i", "İ"), "ı", "I") Then
                    If UserForm11.OptionButton1.Value = True Then
                        yapildi = "YAPILDI"
                        ElseIf UserForm11.OptionButton2.Value = True Then
                        yapildi = "YAPILMADI"
                        ElseIf UserForm11.OptionButton3.Value = True Then
                        yapildi = Sheets("Hatirlat").Cells(k.Row, "E").Value
                    End If
                    If Sheets("Hatirlat").Cells(k.Row, "E").Value = yapildi And _
                        Sheets("Hatirlat").Cells(k.Row, "H").Value = CInt(UserForm11.ComboBox1.Value) Then
                        Cells(i, sut + 2).Value = Cells(i, sut + 2).Value + Sheets("Hatirlat").Cells(k.Row, "C").Value
                    End If
                End If
                Set k = Sheets("Hatirlat").Range("F2:F65536").FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
    Next i
End If

End Sub

 

[Barons]

Hocam süpersin..çok makbule geçti...Allah,sizinde varsa her türlü sıkıntınızı gidersin inş.ferahlık ve esenlikler diliyorum

 

[Orion1]

Hocam süpersin..çok makbule geçti...Allah,sizinde varsa her türlü sıkıntınızı gidersin inş.ferahlık ve esenlikler diliyorum

Rica ederim.
Bilmukabele.