• DİKKAT

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

düşeyara makro kod yardım

T

TURUNCU28

Katılım
23 Nisan 2017
Mesajlar
74
Excel Vers. ve Dili
excel 2010 türkçe
merhaba arkadaşlar
yapmak istediğim userformda tarih olan textbox kısmına tarihi yazdığımızda sayfa2 deki tarihe göre aynı satırdaki ücretleri uygun textboxlara yazsın istiyorum. ayrıca tarihi gün gün yazmak yerine sadece ay ismini yazdığımızda da tüm ayı, yıl yazdığımızda da tüm yılın verilerini toplayıp uygun textboxlara yazsın istiyorum. şimdiden teşekkür ederim umarım anlatabilmişimdir.

Dosyadan şifreleri kaldırıp yeniden ekledim
 

Ekli dosyalar

Son düzenleme:
Merhaba.

Destek istenilen belgelerin sayfa koruma şifresi içermesi veya
VBA kodlarına erişimin şifre ile engellenmesi, destek almanızı ve sorununuzu çözmenizi engeleyecektir.

Bu durum; FORUM KURALLARInın Dosya Ekleme başlıklı bölümüne göre de kurallara uygun değil.
Örnek belgenizi şifresiz olarak yenilemenizi öneriyorum.
.
 
Ömer BARAN' Alıntı:
Merhaba.

Destek istenilen belgelerin sayfa koruma şifresi içermesi veya
VBA kodlarına erişimin şifre ile engellenmesi, destek almanızı ve sorununuzu çözmenizi engeleyecektir.

Bu durum; FORUM KURALLARInın Dosya Ekleme başlıklı bölümüne göre de kurallara uygun değil.
Örnek belgenizi şifresiz olarak yenilemenizi öneriyorum.
.
Genişletmek için tıkla ...

kusura bakmayın dikkatimden kaçmış. Doğru söylüyosunuz heryerde şifre olunca yardım almak da imkansız hale geliyor. Teşekkür ettim. tekrardan kusura bakmayın lütfen
 
arkadaşlar destek olabilecek var mı acaba? dosyada da düzenleme yaptım sayfa koruma sorununu kaldırdım.
 
1. Formatı (Gün olarak) aşağıdaki şekilde kodları değiştirip yapın. Vakit bulursam diğerleri için de yardımcı olmaya çalışırım.
Kod: 
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
TextBox5.Text = Empty
CheckBox3.Value = 0
CheckBox4.Value = 0
Else
Range("B11").ClearContents
End If
End Sub

Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
TextBox5.Text = Empty
CheckBox2.Value = 0
CheckBox4.Value = 0
Else
Range("B11").ClearContents
End If
End Sub

Private Sub CheckBox4_Click()
If CheckBox4.Value = True Then
TextBox5.Text = Empty
CheckBox2.Value = 0
CheckBox3.Value = 0
Else
Range("B11").ClearContents
End If
End Sub


Private Sub TextBox1_Change()
If CheckBox4.Value = True Then
    tarih = CDate(TextBox5)
End If
End Sub



Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa2")
Dim SonSatir As Long
SonSatir = s1.Range("F65536").End(xlUp).Row

If CheckBox4.Value = True Then
    If TextBox5.TextLength <> 10 Then
        MsgBox "Lütfen Tarih formatını gg.aa.yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    Else
        'Kredi Kartı
        TextBox1.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("J2:J" & SonSatir)), "Currency")
        'Nakit
        TextBox2.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("I2:I" & SonSatir)), "Currency")
        'Hesap Kartı
        TextBox3.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("K2:K" & SonSatir)), "Currency")
    End If
ElseIf CheckBox2.Value = True Then
    If TextBox5.TextLength <> 7 Then
        MsgBox "Lütfen Tarih formatını aa.yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    End If
Else
    If TextBox5.TextLength <> 4 Then
        MsgBox "Lütfen Tarih formatını yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    End If
End If
End Sub
 
askm' Alıntı:
1. Formatı (Gün olarak) aşağıdaki şekilde kodları değiştirip yapın. Vakit bulursam diğerleri için de yardımcı olmaya çalışırım.
Kod: 
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
TextBox5.Text = Empty
CheckBox3.Value = 0
CheckBox4.Value = 0
Else
Range("B11").ClearContents
End If
End Sub

Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
TextBox5.Text = Empty
CheckBox2.Value = 0
CheckBox4.Value = 0
Else
Range("B11").ClearContents
End If
End Sub

Private Sub CheckBox4_Click()
If CheckBox4.Value = True Then
TextBox5.Text = Empty
CheckBox2.Value = 0
CheckBox3.Value = 0
Else
Range("B11").ClearContents
End If
End Sub


Private Sub TextBox1_Change()
If CheckBox4.Value = True Then
    tarih = CDate(TextBox5)
End If
End Sub



Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa2")
Dim SonSatir As Long
SonSatir = s1.Range("F65536").End(xlUp).Row

If CheckBox4.Value = True Then
    If TextBox5.TextLength <> 10 Then
        MsgBox "Lütfen Tarih formatını gg.aa.yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    Else
        'Kredi Kartı
        TextBox1.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("J2:J" & SonSatir)), "Currency")
        'Nakit
        TextBox2.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("I2:I" & SonSatir)), "Currency")
        'Hesap Kartı
        TextBox3.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("K2:K" & SonSatir)), "Currency")
    End If
ElseIf CheckBox2.Value = True Then
    If TextBox5.TextLength <> 7 Then
        MsgBox "Lütfen Tarih formatını aa.yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    End If
Else
    If TextBox5.TextLength <> 4 Then
        MsgBox "Lütfen Tarih formatını yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    End If
End If
End Sub
Genişletmek için tıkla ...


çok teşekkür ederim askm. eline sağlık. yalnız kodu yerleştirdiğimde sayfa2 deki l sütunundaki tarihi girdiğimde aynı satırdaki "I","J","K" sütununda ücret değerleri textboxlara geçmiyor. daha doğrusu textboxlara ücret geçiyor ancak 0 tl olarak gözüküyor.
 
Kodlarınız aşağıdaki şekilde.Gün girerken "gg.aa.yyyy", Ay girerken "aa.yyyy"; Yıl girerken de "yyyy" formatında girmeniz gerekir.
Kod: 
Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa2")
Dim SonSatir As Long
SonSatir = s1.Range("F65536").End(xlUp).Row

If CheckBox4.Value = True Then
    If TextBox5.TextLength <> 10 Then
        MsgBox "Lütfen Tarih formatını gg.aa.yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    Else
        'Kredi Kartı
        TextBox1.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("J2:J" & SonSatir)), "Currency")
        'Nakit
        TextBox2.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("I2:I" & SonSatir)), "Currency")
        'Hesap Kartı
        TextBox3.Text = Format(WorksheetFunction.SumIf(s1.Range("L2:L" & SonSatir), CDate(TextBox5.Text), s1.Range("K2:K" & SonSatir)), "Currency")
    End If
ElseIf CheckBox2.Value = True Then
    If TextBox5.TextLength <> 7 Then
        MsgBox "Lütfen Tarih formatını aa.yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    Else
        ayin_ilk_günü = Format(DateValue("01." & Left(TextBox5.Text, 2) & "." & Mid(TextBox5.Text, 4, 7)), "dd.mm.yyyy")
        ayin_son_günü = CDate(WorksheetFunction.EoMonth(CDate(ayin_ilk_günü), 0))
        'Kredi Kartı
            For kki = 2 To SonSatir
                If CDate(s1.Cells(kki, "L").Value) >= CDate(ayin_ilk_günü) And CDate(s1.Cells(kki, "L").Value) <= CDate(ayin_son_günü) Then
                    kks = CDbl(s1.Cells(kki, "J")) + kks
                End If
            Next kki
            TextBox1.Text = Format(kks, "Currency")
        'Nakit
             For nki = 2 To SonSatir
                If CDate(s1.Cells(nki, "L").Value) >= CDate(ayin_ilk_günü) And CDate(s1.Cells(nki, "L").Value) <= CDate(ayin_son_günü) Then
                    nks = CDbl(s1.Cells(kki, "I")) + kks
                End If
            Next nki
            TextBox2.Text = Format(nks, "Currency")
        'Hesap Kartı
            For hki = 2 To SonSatir
                If CDate(s1.Cells(hki, "L").Value) >= CDate(ayin_ilk_günü) And CDate(s1.Cells(hki, "L").Value) <= CDate(ayin_son_günü) Then
                    hks = CDbl(s1.Cells(hki, "K")) + kks
                End If
            Next hki
            TextBox3.Text = Format(hks, "Currency")
    End If
Else
    If TextBox5.TextLength <> 4 Then
        MsgBox "Lütfen Tarih formatını yyyy şeklinde giriniz"
        TextBox5.Text = Empty
    Else
        yil_ilk_g = Format(DateValue("01.01." & TextBox5.Text), "dd.mm.yyyy")
        yil_son_g = Format(DateValue("31.12." & TextBox5.Text), "dd.mm.yyyy")
        
        'Kredi Kartı
            For kkyi = 2 To SonSatir
                If CDate(s1.Cells(kkyi, "L").Value) >= CDate(yil_ilk_g) And CDate(s1.Cells(kkyi, "L").Value) <= CDate(yil_son_g) Then
                    kkys = CDbl(s1.Cells(kkyi, "J")) + kkys
                End If
            Next kkyi
            TextBox1.Text = Format(kkys, "Currency")
        'Nakit
             For nkyi = 2 To SonSatir
                If CDate(s1.Cells(nkyi, "L").Value) >= CDate(yil_ilk_g) And CDate(s1.Cells(nkyi, "L").Value) <= CDate(yil_son_g) Then
                    nkys = CDbl(s1.Cells(nkyi, "I")) + nkys
                End If
            Next nkyi
            TextBox2.Text = Format(nkys, "Currency")
        'Hesap Kartı
            For hkyi = 2 To SonSatir
                If CDate(s1.Cells(hkyi, "L").Value) >= CDate(yil_ilk_g) And CDate(s1.Cells(hkyi, "L").Value) <= CDate(yil_son_g) Then
                    hkys = CDbl(s1.Cells(hkyi, "K")) + hkys
                End If
            Next hkyi
            TextBox3.Text = Format(hkys, "Currency")
    End If
End If
End Sub
 

Ekli dosyalar

Sayın askm uygulanmış halini dosya olarak paylaşabilir misiniz
 
Örnek dosya alt kısmında ekli zaten.
 
Ben mesajı yazarken sayfayı güncellemediğim için ekli değildi, teşekkür ederim.
 
askm' Alıntı:
Örnek dosya alt kısmında ekli zaten.
Genişletmek için tıkla ...

askm merhaba eline sağlık mükemmel bir paylaşım oldu. ancak tarihlerde ay bazlıyı tıkladığımızda hesaplarda hata oluyor. çözmeye çalıştım ancak başaramadım. yıl ve gün bazlıda sıkıntı yok.
ikinci söyleyeceğim acaba gün bazlı ya da ay bazlı 2 tarih arası fiyat seçimi ya da toplamı yaptırabilir miyiz örnek dosyayı ekledim. 2 tarih arası arama yapmak istediğimizde hemen alttaki checkboxı tıklayıp textboxı aktif hale getirsek süper olur. yapılabilir mi bilmiyorum
 

Ekli dosyalar

Benim paylaştığım kodda ay bazında 05.2017 şeklinde yazmanız gerektiği yazıyordu. Bu şekilde deneyin.
 
hks = CDbl(s1.Cells(hki, "K")) + kks kısmını hks = CDbl(s1.Cells(hki, "K")) + hks olarak değiştirin.
 
Topluyor. Önce CheckBox5 i işaretleyin. Sonra TextBox5 =01.05.2017 TextBox6=31.05.2017 yazın. TextBox6 dan çıkınca hesaplama yapacak.
 
askm' Alıntı:
Topluyor. Önce CheckBox5 i işaretleyin. Sonra TextBox5 =01.05.2017 TextBox6=31.05.2017 yazın. TextBox6 dan çıkınca hesaplama yapacak.
Genişletmek için tıkla ...
dediğiniz gibi çalışıyor sanırım benim hatam oldu. tekrardan teşekkür ederim. Peki bu forma birkaç bişey daha ekleyebilir miyiz? Örnek olarak kayıt sırasında firma isimleri de kaydolacak tarihle birlikte. daha sonra ben tarih sorgularkan yan taraftan firma seç alanına firmalar gelebilir mi oradan firma seçim yapıp sadece o firmanın hessabını çıkartabilir miyim?
 
askm' Alıntı:
Topluyor. Önce CheckBox5 i işaretleyin. Sonra TextBox5 =01.05.2017 TextBox6=31.05.2017 yazın. TextBox6 dan çıkınca hesaplama yapacak.
Genişletmek için tıkla ...

askm merhaba, uyguladığımız userformda seçilen tarihte kaç kişiye tahlil yapıldığını gösteren "başvuru sayısı" gibi bir alan da ekleyebilir miyiz? bu arada firma isim tamamlamayı yaptım ama firma seç ile tarih bölmümünü birbirine bağlayamadım maalesef. yeni dosya ektedir
 

Ekli dosyalar

Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst