Makro Düzenleme

[ormann]

Ekteki örnek dosyada bulunan cetvelde 1.satırda cumartesi günleri "x" ile pzar günleri "p" ile gösterilecek,2.satırda cumartesi günleri "p" ile pzar günleri ise "x" şeklinde gösterilecek devamıda aynı şekilde olacak .Ekteki örnek dosyanın içierisinde bulunan makroyu bu şekilde olacak biçimde düzenleyebilirmisiniz.Saygılar

 

[Orion1]

Aşağıdaki kodlar işinizi görecektir.

Sub Puantaj()

    Dim Sat As Long, _
        Sut As Integer, _
        Son As Long
    
    Son = Cells(Rows.Count, "B").End(3).Row - 1
    If Son < 18 Then Son = 18
    
    Application.ScreenUpdating = False
    Range("C18:AG" & Son).ClearContents
    For Sat = 18 To Son
        Sut = 3
        If Not Cells(Sat, "B") = "" Then
            Do
                Cells(Sat, Sut) = "X"
                If Sat Mod 2 = 0 Then
                    If Weekday(Cells(17, Sut), 2) = 7 Then Cells(Sat, Sut) = "P"
                ElseIf Sat Mod 2 = 1 Then
                    If Weekday(Cells(17, Sut), 2) = 6 Then Cells(Sat, Sut) = "P"
                End If
                Sut = Sut + 1
            Loop While Not Cells(17, Sut) = "" And Sut < 34
        End If
    Next Sat
    
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır...." & vbLf & "22.04.2011" & vbLf & "evrengizlenqhotmail.com", vbInformation, ""

End Sub

 

[ormann]

Çok teşekkürler Sayın Evren Bey

 

[ormann]

Sayın Evren Bey çok teşekkür ederim .Tam istediğim şekilde olmuş.sizden ricam ekteki puantaj cetvelinde 15.07.2011 diye bir tarih girdiğimde makroda aşağıdaki hatayı veriyo .Birde n16 hücresine puntajın başlangıç ayını ve t16 hücresine ise bittiği ayı yapabilirmisiniz.saygılar sunuyorum.


Sub Puantaj()

Dim Sat As Long, _
Sut As Integer, _
Son As Long

Son = Cells(Rows.Count, "A").End(3).Row
If Son < 18 Then Son = 18

Application.ScreenUpdating = False
Range("C18:AG" & Son).ClearContents
For Sat = 18 To Son
Sut = 3
If Not Cells(Sat, "B") = "" Then
Do
If Weekday(Cells(17, Sut), 2) = 7 Then
Cells(Sat, Sut) = "P"
Else
Cells(Sat, Sut) = "X"
End If
Sut = Sut + 1
Loop While Not Cells(17, Sut) = ""
End If
Next Sat

Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır....", vbInformation, ""

End Sub

 

[Orion1]

Bu gönderdiğiniz kod benim yolladığıma benzemiyor.
benim yolladığımda eneyin ayni şeyi bakalım hata verecekmi?
Vermiyorsa siz bu düzenleme yaptığınızı benim yazdığıma bakarak tekrar düzenleyin.:cooL.

Sayın Evren Bey çok teşekkür ederim .Tam istediğim şekilde olmuş.sizden ricam ekteki puantaj cetvelinde 15.07.2011 diye bir tarih girdiğimde makroda aşağıdaki hatayı veriyo .Birde n16 hücresine puntajın başlangıç ayını ve t16 hücresine ise bittiği ayı yapabilirmisiniz.saygılar sunuyorum.


Sub Puantaj()

Dim Sat As Long, _
Sut As Integer, _
Son As Long

Son = Cells(Rows.Count, "A").End(3).Row
If Son < 18 Then Son = 18

Application.ScreenUpdating = False
Range("C18:AG" & Son).ClearContents
For Sat = 18 To Son
Sut = 3
If Not Cells(Sat, "B") = "" Then
Do
If Weekday(Cells(17, Sut), 2) = 7 Then
Cells(Sat, Sut) = "P"
Else
Cells(Sat, Sut) = "X"
End If
Sut = Sut + 1
Loop While Not Cells(17, Sut) = ""
End If
Next Sat

Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır....", vbInformation, ""

End Sub

 

[ormann]

Sayın Evren Hocam bu başka bir tablo .Diğeri farklıydı.Bunu düzenlerseniz memnun olurum.Birde bir önceki tabloda hocam benim istediğim makroların c18:ag29 hücre aralığına atması bunuda yapabilirmisiniz.Saygılar

 

[Necdet]

Bana ihanet haaa

peki öyle olsun

 

[ormann]

yok hocam estağfirullah

 

[Skorpiyon]

(mesaj kısa diye sadece gülücük bile gönderemiyoruz ya)

 

[Orion1]

For Sat = 18 To [B][COLOR="Red"]29[/COLOR][/B]
        Sut = 3
        If Not Cells(Sat, "B") = "" Then
            Do
                Cells(Sat, Sut) = "X"
                If Sat Mod 2 = 0 Then
                    If Weekday(Cells(17, Sut), 2) = 7 Then Cells(Sat, Sut) = "P"
                ElseIf Sat Mod 2 = 1 Then
                    If Weekday(Cells(17, Sut), 2) = 6 Then Cells(Sat, Sut) = "P"
                End If
                Sut = Sut + 1
            Loop While Not Cells(17, Sut) = "" And [B][COLOR="Red"]Sut <=range("AG29").column[/COLOR][/B]
        End If
    Next Sat

Sayın Evren Hocam bu başka bir tablo .Diğeri farklıydı.Bunu düzenlerseniz memnun olurum.Birde bir önceki tabloda hocam benim istediğim makroların c18:ag29 hücre aralığına atması bunuda yapabilirmisiniz.Saygılar

 

[Orion1]

İlgili kodu aşağıdaki ile değiştirin.
2 tarih konusunu bir miktar daha açıklamalasınız.
anlamadım

Loop While Cells(17, Sut) <> "" And Sut <= 33

Sayın Evren Bey çok teşekkür ederim .Tam istediğim şekilde olmuş.sizden ricam ekteki puantaj cetvelinde 15.07.2011 diye bir tarih girdiğimde makroda aşağıdaki hatayı veriyo .Birde n16 hücresine puntajın başlangıç ayını ve t16 hücresine ise bittiği ayı yapabilirmisiniz.saygılar sunuyorum.


Sub Puantaj()

Dim Sat As Long, _
Sut As Integer, _
Son As Long

Son = Cells(Rows.Count, "A").End(3).Row
If Son < 18 Then Son = 18

Application.ScreenUpdating = False
Range("C18:AG" & Son).ClearContents
For Sat = 18 To Son
Sut = 3
If Not Cells(Sat, "B") = "" Then
Do
If Weekday(Cells(17, Sut), 2) = 7 Then
Cells(Sat, Sut) = "P"
Else
Cells(Sat, Sut) = "X"
End If
Sut = Sut + 1
Loop While Not Cells(17, Sut) = ""
End If
Next Sat

Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır....", vbInformation, ""

End Sub