Hücre İçerisine Girilen Tarihe Göre Ayın Günlerini Listeleme

G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
Merhabalar ( Excel mokroları öğrenmeye çalışan biriyim) 2 konuda yardıma ihtiyacım var tecrübeli ve bilgi sahibi olanlardan yardımcı olmalarını rica ediyorum
1. sorum diyelim ki A1 hücresine Ocak ayının tarihini 01/01/2020 girdim B1 hücresinden başlayarak sadece o ayın günlerini sıralasın, şubat ayının ilk gününü girdiğimde aynı şekilde şubat ayını sıralasın (ayın 28,29,30 ve 31 olması durumuna göre sadece tarihi yazılan ayın günleri)
2. sorum bir adet öğrenci bilgilerinin olduğu bir toplu listem var listedeki herhangi bir öğrencinin karşısındaki ilgili kutucuğa tarih girip kaydet düğmesine bastığımda tarih girilen öğrencinin TC. kimlik numarasından öğrenci hangi şubede ise o sayfayı açsın ve girilen tarihi öğrencinin satırındaki boş olan ilk hücreye yapıştırsın örnek dosyayı ekledim yardımlarınız için şimdiden çok teşekkür ediyorum

örnek dosya
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
1. isteğiniz için B1 hücresine aşağıdaki formülü yazıp sağa doğru kopyalayın:

=EĞER(A1="";"";EĞER(AY(A1)=AY(A1+1);A1+1;""))

İkinci isteğiniz için aşağıdaki kodları TOPLU LİSTE sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyiniz. D sütununa tarih girildiğinde işlem yapar:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
son = Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range("D2:D" & son)) Is Nothing Then Exit Sub
If IsDate(Target) = True Then
    For sayfa = 1 To Sheets.Count
        sube = "yok"
        If Sheets(sayfa).Name = Target.Offset(0, -1) Then
            sube = "Var"
            sonA = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
            If WorksheetFunction.CountIf(Sheets(sayfa).Range("A1:A" & sonA), Target.Offset(0, -3)) > 0 Then
                sat = WorksheetFunction.Match(Target.Offset(0, -3), Sheets(sayfa).Range("A1:A" & sonA), 0)
                Sheets(sayfa).Cells(sat, Month(Target) + 3) = Target
                Sheets(sayfa).Cells(sat, Month(Target) + 3).NumberFormat = "dd/mm/yyyy"
                MsgBox "işlem tamamlandı"
                Exit Sub
            Else
                MsgBox Sheets(sayfa).Name & " şubesinde " & Target.Offset(0, -2) & " adlı öğrenci bulunamadı!", vbCritical
            End If
        End If
    Next
    If sube = "yok" Then
        MsgBox Target.Offset(0, -1) & " şubesine ait sayfa bulunamadı!", vbCritical
    End If
End If
End Sub
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
YUSUF44' Alıntı:
1. isteğiniz için B1 hücresine aşağıdaki formülü yazıp sağa doğru kopyalayın:

=EĞER(A1="";"";EĞER(AY(A1)=AY(A1+1);A1+1;""))

İkinci isteğiniz için aşağıdaki kodları TOPLU LİSTE sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyiniz. D sütununa tarih girildiğinde işlem yapar:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
son = Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range("D2:D" & son)) Is Nothing Then Exit Sub
If IsDate(Target) = True Then
    For sayfa = 1 To Sheets.Count
        sube = "yok"
        If Sheets(sayfa).Name = Target.Offset(0, -1) Then
            sube = "Var"
            sonA = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
            If WorksheetFunction.CountIf(Sheets(sayfa).Range("A1:A" & sonA), Target.Offset(0, -3)) > 0 Then
                sat = WorksheetFunction.Match(Target.Offset(0, -3), Sheets(sayfa).Range("A1:A" & sonA), 0)
                Sheets(sayfa).Cells(sat, Month(Target) + 3) = Target
                Sheets(sayfa).Cells(sat, Month(Target) + 3).NumberFormat = "dd/mm/yyyy"
                MsgBox "işlem tamamlandı"
                Exit Sub
            Else
                MsgBox Sheets(sayfa).Name & " şubesinde " & Target.Offset(0, -2) & " adlı öğrenci bulunamadı!", vbCritical
            End If
        End If
    Next
    If sube = "yok" Then
        MsgBox Target.Offset(0, -1) & " şubesine ait sayfa bulunamadı!", vbCritical
    End If
End If
End Sub
Genişletmek için tıkla ...
Sayın Yusuf 44 çok teşekkür ederim her 2 kod da sorunsuz çalışıyor fakat 2 kod daki işlemleri yaptırmak için sayfa değiştiğinde komutu yerine kaydet düğmesine basılınca şeklinde yapsak çünkü yanlış bir tarih girdim diyelim ki ve yanlışlıkla bir alt satıra geçsem bile kayıt yapıyor
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki şekilde olabilir. Makro çalıştığında D sütunu dolu olan satırların tarihini ilgili sayfalara aktarır:

Kod: 
Sub aktar()
Set s1 = Sheets("TOPLU LİSTE")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:D" & son).Interior.Color = xlNone
For i = 2 To son
    If IsDate(s1.Cells(i, "D")) = True Then
        sube = "yok"
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name = s1.Cells(i, "C") Then
                sube = "Var"
                sonA = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
                If WorksheetFunction.CountIf(Sheets(sayfa).Range("A1:A" & sonA), s1.Cells(i, "A")) > 0 Then
                    sat = WorksheetFunction.Match(s1.Cells(i, "A"), Sheets(sayfa).Range("A1:A" & sonA), 0)
                    Sheets(sayfa).Cells(sat, Month(s1.Cells(i, "D")) + 3) = s1.Cells(i, "D")
                    Sheets(sayfa).Cells(sat, Month(s1.Cells(i, "D")) + 3).NumberFormat = "dd/mm/yyyy"
                Else
                    s1.Range("A" & i & ":D" & i).Interior.Color = vbYellow
                End If
            End If
        Next
        If sube = "yok" Then
            s1.Range("A" & i & ":D" & i).Interior.Color = vbRed
        End If
    End If
Next
MsgBox "İşlem tamamlandı" & Chr(10) & Chr(10) & "Bulunmayan şubeler kırmızıya, şubesinde bulunmayan öğrenci sarıya boyandı.", vbInformation
End Sub
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
YUSUF44' Alıntı:
Aşağıdaki şekilde olabilir. Makro çalıştığında D sütunu dolu olan satırların tarihini ilgili sayfalara aktarır:

Kod: 
Sub aktar()
Set s1 = Sheets("TOPLU LİSTE")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:D" & son).Interior.Color = xlNone
For i = 2 To son
    If IsDate(s1.Cells(i, "D")) = True Then
        sube = "yok"
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name = s1.Cells(i, "C") Then
                sube = "Var"
                sonA = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
                If WorksheetFunction.CountIf(Sheets(sayfa).Range("A1:A" & sonA), s1.Cells(i, "A")) > 0 Then
                    sat = WorksheetFunction.Match(s1.Cells(i, "A"), Sheets(sayfa).Range("A1:A" & sonA), 0)
                    Sheets(sayfa).Cells(sat, Month(s1.Cells(i, "D")) + 3) = s1.Cells(i, "D")
                    Sheets(sayfa).Cells(sat, Month(s1.Cells(i, "D")) + 3).NumberFormat = "dd/mm/yyyy"
                Else
                    s1.Range("A" & i & ":D" & i).Interior.Color = vbYellow
                End If
            End If
        Next
        If sube = "yok" Then
            s1.Range("A" & i & ":D" & i).Interior.Color = vbRed
        End If
    End If
Next
MsgBox "İşlem tamamlandı" & Chr(10) & Chr(10) & "Bulunmayan şubeler kırmızıya, şubesinde bulunmayan öğrenci sarıya boyandı.", vbInformation
End Sub
Genişletmek için tıkla ...
Sayın Yusuf 44 son düzenlemeniz sıkıntısız çalışmakta fakat şöyle bir problem var diyelim ki X kişisi için tarih girişi yapıp kaydet dediğimde girilen tarihi X kişisinin bilgilerinin olduğu satırdaki boş olan ilk hücreye kopyalasın siz girilen tarihteki ayı baz almışsınız aya göre değil de nisan tarihi bile girsek eğer ocak boş ise oraya kopyalasın sonraki girdiğimiz tarihi şubat ayına gibi
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi deneyin:
PHP: 
Sub aktar()
Set s1 = Sheets("TOPLU LİSTE")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:D" & son).Interior.Color = xlNone
For i = 2 To son
    If IsDate(s1.Cells(i, "D")) = True Then
        sube = "yok"
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name = s1.Cells(i, "C") Then
                sube = "Var"
                sonA = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
                If WorksheetFunction.CountIf(Sheets(sayfa).Range("A1:A" & sonA), s1.Cells(i, "A")) > 0 Then
                    sat = WorksheetFunction.Match(s1.Cells(i, "A"), Sheets(sayfa).Range("A1:A" & sonA), 0)
                    sut = WorksheetFunction.Max(4, Sheets(sayfa).Cells(sat, Columns.Count).End(xlToLeft).Column + 1)
                    Sheets(sayfa).Cells(sat, sut) = s1.Cells(i, "D")
                    Sheets(sayfa).Cells(sat, sut).NumberFormat = "dd/mm/yyyy"
                Else
                    s1.Range("A" & i & ":D" & i).Interior.Color = vbYellow
                End If
            End If
        Next
        If sube = "yok" Then
            s1.Range("A" & i & ":D" & i).Interior.Color = vbRed
        End If
    End If
Next
MsgBox "İşlem tamamlandı" & Chr(10) & Chr(10) & "Bulunmayan şubeler kırmızıya, şubesinde bulunmayan öğrenci sarıya boyandı.", vbInformation
End Sub
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
YUSUF44' Alıntı:
Aşağıdaki gibi deneyin:
PHP: 
Sub aktar()
Set s1 = Sheets("TOPLU LİSTE")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:D" & son).Interior.Color = xlNone
For i = 2 To son
    If IsDate(s1.Cells(i, "D")) = True Then
        sube = "yok"
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name = s1.Cells(i, "C") Then
                sube = "Var"
                sonA = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row
                If WorksheetFunction.CountIf(Sheets(sayfa).Range("A1:A" & sonA), s1.Cells(i, "A")) > 0 Then
                    sat = WorksheetFunction.Match(s1.Cells(i, "A"), Sheets(sayfa).Range("A1:A" & sonA), 0)
                    sut = WorksheetFunction.Max(4, Sheets(sayfa).Cells(sat, Columns.Count).End(xlToLeft).Column + 1)
                    Sheets(sayfa).Cells(sat, sut) = s1.Cells(i, "D")
                    Sheets(sayfa).Cells(sat, sut).NumberFormat = "dd/mm/yyyy"
                Else
                    s1.Range("A" & i & ":D" & i).Interior.Color = vbYellow
                End If
            End If
        Next
        If sube = "yok" Then
            s1.Range("A" & i & ":D" & i).Interior.Color = vbRed
        End If
    End If
Next
MsgBox "İşlem tamamlandı" & Chr(10) & Chr(10) & "Bulunmayan şubeler kırmızıya, şubesinde bulunmayan öğrenci sarıya boyandı.", vbInformation
End Sub
Genişletmek için tıkla ...
işte bu sefer 10 numara 5 yıldız olmuş sayın yusuf 44 elinize emeğinize sağlık uğraşlarınız için çok teşekkür ederim
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
guter24' Alıntı:
işte bu sefer 10 numara 5 yıldız olmuş sayın yusuf 44 elinize emeğinize sağlık uğraşlarınız için çok teşekkür ederim
Genişletmek için tıkla ...
Merhabalar Sayın Yusuf44 tekrardan rahatsız ediyorum sizi k.bakmayın ama daha önceden aynı konu için yazmış olduğunuz kodları ek olarak eklediğim çalışma dosyama bir türlü uyarlayamadım o yüzden tekrar yardımlarınızı rica ediyorum.
daha önceki mesajlarda yüklemiş olduğum dosyadaki öğrenciye ait aidat girişinin yapıldığı tarihi ve aidat miktarını öğrencinin isminin bulunduğu sınıfta bulup karşısındaki boş olan ilk hücreye kopyalayacak. Örnek dosya linktedir.

ÖĞRENCİ BİLGİ KAYIT
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki makroyu deneyiniz:

PHP: 
Sub aktar()
Set s1 = Sheets("AİDAT")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:F" & son).Interior.Color = xlNone
For i = 2 To son
    If IsDate(s1.Cells(i, "E")) = True Then
        sube = "yok"
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name = s1.Cells(i, "D") Then
                sube = "Var"
                sonB = Sheets(sayfa).Cells(Rows.Count, "B").End(3).Row
                If WorksheetFunction.CountIf(Sheets(sayfa).Range("B1:B" & sonB), s1.Cells(i, "B")) > 0 Then
                    sat = WorksheetFunction.Match(s1.Cells(i, "B"), Sheets(sayfa).Range("B1:B" & sonB), 0)
                    sut = WorksheetFunction.Max(14, Sheets(sayfa).Cells(sat, Columns.Count).End(xlToLeft).Column + 1)
                    Sheets(sayfa).Cells(sat, sut) = s1.Cells(i, "E")
                    Sheets(sayfa).Cells(sat, sut).NumberFormat = "dd/mm/yyyy"
                    Sheets(sayfa).Cells(sat, sut + 1) = s1.Cells(i, "F")
                    Sheets(sayfa).Cells(sat, sut + 1).NumberFormat = "#,##0.00 TL"
                Else
                    s1.Range("A" & i & ":F" & i).Interior.Color = vbYellow
                End If
            End If
        Next
        If sube = "yok" Then
            s1.Range("A" & i & ":F" & i).Interior.Color = vbRed
        End If
    End If
Next
MsgBox "İşlem tamamlandı" & Chr(10) & Chr(10) & "Bulunmayan şubeler kırmızıya, şubesinde bulunmayan öğrenci sarıya boyandı.", vbInformation
End Sub
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
YUSUF44' Alıntı:
Sub aktar() Set s1 = Sheets("AİDAT") son = s1.Cells(Rows.Count, "A").End(3).Row s1.Range("A1:F" & son).Interior.Color = xlNone For i = 2 To son If IsDate(s1.Cells(i, "E")) = True Then sube = "yok" For sayfa = 1 To Sheets.Count If Sheets(sayfa).Name = s1.Cells(i, "D") Then sube = "Var" sonB = Sheets(sayfa).Cells(Rows.Count, "B").End(3).Row If WorksheetFunction.CountIf(Sheets(sayfa).Range("B1:B" & sonB), s1.Cells(i, "B")) > 0 Then sat = WorksheetFunction.Match(s1.Cells(i, "B"), Sheets(sayfa).Range("B1:B" & sonB), 0) sut = WorksheetFunction.Max(14, Sheets(sayfa).Cells(sat, Columns.Count).End(xlToLeft).Column + 1) Sheets(sayfa).Cells(sat, sut) = s1.Cells(i, "E") Sheets(sayfa).Cells(sat, sut).NumberFormat = "dd/mm/yyyy" Sheets(sayfa).Cells(sat, sut + 1) = s1.Cells(i, "F") Sheets(sayfa).Cells(sat, sut + 1).NumberFormat = "#,##0.00 TL" Else s1.Range("A" & i & ":F" & i).Interior.Color = vbYellow End If End If Next If sube = "yok" Then s1.Range("A" & i & ":F" & i).Interior.Color = vbRed End If End If Next MsgBox "İşlem tamamlandı" & Chr(10) & Chr(10) & "Bulunmayan şubeler kırmızıya, şubesinde bulunmayan öğrenci sarıya boyandı.", vbInformation End Sub
Genişletmek için tıkla ...
maalesef hata veriyor öğrencileri sarı arka planında işaretliyor ve ilgili sayfadaki karşılarına veriyi kopyalamıyor
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aidat sayfasındaki TC numaralarıyla şubelerdeki TC numaraları birbirinden farklı olduğundan olmasın ;)
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
guter24' Alıntı:
haklıymışsınız üstat o benim gözümden kaçmış :) çok teşekkür ederim size
Genişletmek için tıkla ...
Sayın Yusuf 44 biliyorum sizden çok fazla şey istedim hakkınızı helal edin.
yazmış olduğunuz kodlara şöyle bir ekleme yapacak olsak acaba mümkün müdür ? E sütununda herhangi bir öğrencinin isminin karşısına tarih girişini yaptık ve acele ile aidat miktarını girmeden kaydet dediğimizde sadece tarih olacak şekilde kayıt yapmakta fakat bunun yerine Msg Box ile uyarı verip öğrenciye ait tarih veya aidat hücrelerinden birisi boş olduğunda kaydetmeye izin vermese aidat ve tarih hücrelerinin her ikisi de dolu olduğunda kaydetme işlemini yapsa
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Estağfurullah, sonuçta zorla yapmıyorum. Aşağıdaki gibi deneyin:

PHP: 
Sub aktar()
Set s1 = Sheets("AİDAT")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:F" & son).Interior.Color = xlNone
For i = 2 To son
    If IsDate(s1.Cells(i, "E")) = True Then
        If s1.Cells(i, "F") > 0 Then
            sube = "yok"
            For sayfa = 1 To Sheets.Count
                If Sheets(sayfa).Name = s1.Cells(i, "D") Then
                    sube = "Var"
                    sonB = Sheets(sayfa).Cells(Rows.Count, "B").End(3).Row
                    If WorksheetFunction.CountIf(Sheets(sayfa).Range("B1:B" & sonB), s1.Cells(i, "B")) > 0 Then
                        sat = WorksheetFunction.Match(s1.Cells(i, "B"), Sheets(sayfa).Range("B1:B" & sonB), 0)
                        sut = WorksheetFunction.Max(14, Sheets(sayfa).Cells(sat, Columns.Count).End(xlToLeft).Column + 1)
                        Sheets(sayfa).Cells(sat, sut) = s1.Cells(i, "E")
                        Sheets(sayfa).Cells(sat, sut).NumberFormat = "dd/mm/yyyy"
                        Sheets(sayfa).Cells(sat, sut + 1) = s1.Cells(i, "F")
                        Sheets(sayfa).Cells(sat, sut + 1).NumberFormat = "#,##0.00 TL"
                    Else
                        s1.Range("A" & i & ":F" & i).Interior.Color = vbYellow
                    End If
                End If
            Next
            If sube = "yok" Then
                s1.Range("A" & i & ":F" & i).Interior.Color = vbRed
            End If
        Else
            s1.Range("A" & i & ":F" & i).Interior.ThemeColor = xlThemeColorAccent1
        End If
    End If
Next
MsgBox "İşlem tamamlandı" & Chr(10) & Chr(10) & "Bulunmayan şubeler kırmızıya, " & _
        Chr(10) & "Şubesinde bulunmayan öğrenci sarıya," & _
        Chr(10) & "Ödeme tutarı olmayan öğrenci maviye boyandı.", vbInformation
End Sub
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
YUSUF44' Alıntı:
Estağfurullah, sonuçta zorla yapmıyorum. Aşağıdaki gibi deneyin:

PHP: 
Sub aktar()
Set s1 = Sheets("AİDAT")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:F" & son).Interior.Color = xlNone
For i = 2 To son
    If IsDate(s1.Cells(i, "E")) = True Then
        If s1.Cells(i, "F") > 0 Then
            sube = "yok"
            For sayfa = 1 To Sheets.Count
                If Sheets(sayfa).Name = s1.Cells(i, "D") Then
                    sube = "Var"
                    sonB = Sheets(sayfa).Cells(Rows.Count, "B").End(3).Row
                    If WorksheetFunction.CountIf(Sheets(sayfa).Range("B1:B" & sonB), s1.Cells(i, "B")) > 0 Then
                        sat = WorksheetFunction.Match(s1.Cells(i, "B"), Sheets(sayfa).Range("B1:B" & sonB), 0)
                        sut = WorksheetFunction.Max(14, Sheets(sayfa).Cells(sat, Columns.Count).End(xlToLeft).Column + 1)
                        Sheets(sayfa).Cells(sat, sut) = s1.Cells(i, "E")
                        Sheets(sayfa).Cells(sat, sut).NumberFormat = "dd/mm/yyyy"
                        Sheets(sayfa).Cells(sat, sut + 1) = s1.Cells(i, "F")
                        Sheets(sayfa).Cells(sat, sut + 1).NumberFormat = "#,##0.00 TL"
                    Else
                        s1.Range("A" & i & ":F" & i).Interior.Color = vbYellow
                    End If
                End If
            Next
            If sube = "yok" Then
                s1.Range("A" & i & ":F" & i).Interior.Color = vbRed
            End If
        Else
            s1.Range("A" & i & ":F" & i).Interior.ThemeColor = xlThemeColorAccent1
        End If
    End If
Next
MsgBox "İşlem tamamlandı" & Chr(10) & Chr(10) & "Bulunmayan şubeler kırmızıya, " & _
        Chr(10) & "Şubesinde bulunmayan öğrenci sarıya," & _
        Chr(10) & "Ödeme tutarı olmayan öğrenci maviye boyandı.", vbInformation
End Sub
Genişletmek için tıkla ...
Çok teşekkür ederim Yusuf bey bu kez kodlar tıkır tıkır sıkıntısız çalışıyor. Başka takıldığım noktalar olduğunda yardımınız için size tekrardan rahatsızlık verebilir miyim ? ( İçinizden selam verdik borçlu çıktık dediğinizi duyar gibiyim :) ) Konu dışı bir başka sorum olacaktı bir çalışma sayfam var D10 hücresine sağ tıklanınca takvim açılmakta fakat ben bu sağ tık olayını sayfaya ekleyeceğim bir buton ile yapmak istiyorum sizce nasıl bir yol izlemek lazım eğer mümkün değil ise çift tıklama ile açması da olabilir. ben tek tıklama ile olan komutu girip işlemi buton ile yaptırabiliyorum ama diğerlerini başaramadım maalesef
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
guter24' Alıntı:
Çok teşekkür ederim Yusuf bey bu kez kodlar tıkır tıkır sıkıntısız çalışıyor. Başka takıldığım noktalar olduğunda yardımınız için size tekrardan rahatsızlık verebilir miyim ? ( İçinizden selam verdik borçlu çıktık dediğinizi duyar gibiyim :) ) Konu dışı bir başka sorum olacaktı bir çalışma sayfam var D10 hücresine sağ tıklanınca takvim açılmakta fakat ben bu sağ tık olayını sayfaya ekleyeceğim bir buton ile yapmak istiyorum sizce nasıl bir yol izlemek lazım eğer mümkün değil ise çift tıklama ile açması da olabilir. ben tek tıklama ile olan komutu girip işlemi buton ile yaptırabiliyorum ama diğerlerini başaramadım maalesef
Genişletmek için tıkla ...

Bu forum paylaşım için var, elimizden geldiğince yardımcı olmaya çalışırız.

Sorunuzla ilgili örnek dosya olursa iyi olur.
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
YUSUF44' Alıntı:
Bu forum paylaşım için var, elimizden geldiğince yardımcı olmaya çalışırız.

Sorunuzla ilgili örnek dosya olursa iyi olur.
Genişletmek için tıkla ...
Yusuf bey örnek dosyayı ekledim kayıt sayfasındaki D10 ve D16 hücrelerine sağ tıklayınca takvim açılmakta ben ise aynı hücrelere eklediğim düğmeler ile açılmasını istiyorum

ÖRNEK DOSYA
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Bir modüle aşağıdaki kodları kopyalayın:

PHP: 
Sub takvimleD10()
    Sheets("KAYIT").Activate
    Sheets("KAYIT").[D10].Select
    Takvim.Show
End Sub


Sub takvimleD16()
    Sheets("KAYIT").Activate
    Sheets("KAYIT").[D16].Select
    Takvim.Show
End Sub
D10'daki düğmeye sağ tıklayıp Makro ata deyin ve TakvimleD10 makrosunu seçin.

D16'daki düğmeye sağ tıklayıp Makro Ata deyin ve TakvimleD16 makrosunu seçin.

KAYIT sayfasının kod bölümündeki (sağ tıklamaya bağlı) kodları silin.
 
G

guter24

Katılım
2 Ekim 2015
Mesajlar
72
Excel Vers. ve Dili
2019 TR
YUSUF44' Alıntı:
Bir modüle aşağıdaki kodları kopyalayın:

PHP: 
Sub takvimleD10()
    Sheets("KAYIT").Activate
    Sheets("KAYIT").[D10].Select
    Takvim.Show
End Sub


Sub takvimleD16()
    Sheets("KAYIT").Activate
    Sheets("KAYIT").[D16].Select
    Takvim.Show
End Sub
D10'daki düğmeye sağ tıklayıp Makro ata deyin ve TakvimleD10 makrosunu seçin.

D16'daki düğmeye sağ tıklayıp Makro Ata deyin ve TakvimleD16 makrosunu seçin.

KAYIT sayfasının kod bölümündeki (sağ tıklamaya bağlı) kodları silin.
Genişletmek için tıkla ...
Boşuna dememişler hiç bilenle bilmeyen bir olur mu diye emeğinize sağlık tekrardan çok teşekkür ederim Yusuf bey
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst