Hafta sonuna denk geliyor ise hafta başına at

[Cengizhantr06]

Girişler sayfasında E2:E ye kadar tarih girilecek ve tarih girince otomatik aynı tarihi F2:F sütununa atacak ama E2 ye girilen tarihler cumartesi veya pazara denk geliyorsa F2:F ye geçerken pazartesine atacak otomatik. Hafta içine denk geliyorsa değişmeyecek ama hafta sonuna denk geliyorsa direk pazartesi ye atacak mesala cumartesi ise pazartesiye atacak pazar ise yine pazartesiye atacak lütfen yardımlarınızı bekliyorum değişken adları ile yaparsansanız cok iyi olur

 

[S.Yiğit]

Merhaba,

F2 hücresine bu formülü dener misiniz?

=ELEMAN(HAFTANINGÜNÜ(E2;2);E2;E2;E2;E2;E2;E2+2;E2+1)

 

[Ömer]

Merhaba,

Alternatif.

=İŞGÜNÜ(E2;--(HAFTANINGÜNÜ(E2;2)>5))

.

 

[Cengizhantr06]

Merhaba,

F2 hücresine bu formülü dener misiniz?

=ELEMAN(HAFTANINGÜNÜ(E2;2);E2;E2;E2;E2;E2;E2+2;E2+1)

Özür dilerim VBA kod olması gerek lütfen

 

[Cengizhantr06]

Merhaba,

Alternatif.

=İŞGÜNÜ(E2;--(HAFTANINGÜNÜ(E2;2)>5))

.

Özür dilerim VBA kod istiyorum lütfen

 

[Cengizhantr06]

Özür dilerim VBA kod istiyorum lütfen

Vba olarak yardımcı olabilir misiniz lütfen

 

[Cengizhantr06]

Özür dilerim VBA kod olması gerek lütfen

Vba olarak yardımcı olabilir misiniz lütfen

 

[Korhan Ayhan]

Sayfanızın kod bölümüne uygulayıp deneyiniz.

İlgili alana tarih girişi yaptığınızda işlem otomatik yapılacaktır.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range
    
    If Intersect(Target, Range("E2:E" & Rows.Count)) Is Nothing Then Exit Sub
    
    For Each Veri In Intersect(Target, Range("E2:E" & Rows.Count))
        If IsDate(Veri.Value) Then
            Select Case Weekday(Veri.Value, vbMonday)
                Case 6: Veri.Offset(0, 1) = Veri.Value + 2
                Case 7: Veri.Offset(0, 1) = Veri.Value + 1
                Case Else: Veri.Offset(0, 1) = Veri.Value
            End Select
        ElseIf Veri.Value = "" Or Not IsNumeric(Veri.Value) Then
            Veri.Offset(0, 1).ClearContents
        End If
    Next
End Sub

 

[Ömer]

Deneyiniz.

Sub isgunu()
        
    Dim i As Long, a As Byte
    
    Application.ScreenUpdating = False
    Range("F2:F" & Rows.Count) = ""
    
    For i = 2 To Cells(Rows.Count, "E").End(xlUp).Row
        a = 0
        If Weekday(Cells(i, "E"), 2) > 5 Then a = Abs(Weekday(Cells(i, "E"), 2) - 8)
        Cells(i, "F") = Cells(i, "E") + a
    Next i

End Sub

 

[Cengizhantr06]

Sayfanızın kod bölümüne uygulayıp deneyiniz.

İlgili alana tarih girişi yaptığınızda işlem otomatik yapılacaktır.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range
   
    If Intersect(Target, Range("E2:E" & Rows.Count)) Is Nothing Then Exit Sub
   
    For Each Veri In Intersect(Target, Range("E2:E" & Rows.Count))
        If IsDate(Veri.Value) Then
            Select Case Weekday(Veri.Value, vbMonday)
                Case 6: Veri.Offset(0, 1) = Veri.Value + 2
                Case 7: Veri.Offset(0, 1) = Veri.Value + 1
                Case Else: Veri.Offset(0, 1) = Veri.Value
            End Select
        ElseIf Veri.Value = "" Or Not IsNumeric(Veri.Value) Then
            Veri.Offset(0, 1).ClearContents
        End If
    Next
End Sub

Çok sağolun çok makbule gecti inanın Korhan Bey

 

[Cengizhantr06]

Deneyiniz.

Sub isgunu()
       
    Dim i As Long, a As Byte
   
    Application.ScreenUpdating = False
    Range("F2:F" & Rows.Count) = ""
   
    For i = 2 To Cells(Rows.Count, "E").End(xlUp).Row
        a = 0
        If Weekday(Cells(i, "E"), 2) > 5 Then a = Abs(Weekday(Cells(i, "E"), 2) - 8)
        Cells(i, "F") = Cells(i, "E") + a
    Next i

End Sub

Ömer bey çok sağlun çok lazımdı

 

[Necdet]

Merhaba,

Ömer Bey'in fonksiyonla verdiği kodun makro halini de seçenek olarak ben vereyim.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [E:E]) Is Nothing Or Target.Row < 2 Then Exit Sub
   
    If Not Target.Value = "" Then _
    Target.Offset(0, 1) = Evaluate("=WORKDAY(" & CDbl(Target.Value) & ",--(WEEKDAY(" & CDbl(Target.Value) & ",2)>5))")
   
End Sub

 

[Cengizhantr06]

Merhaba,

Ömer Bey'in fonksiyonla verdiği kodun makro halini de seçenek olarak ben vereyim.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [E:E]) Is Nothing Or Target.Row < 2 Then Exit Sub
  
    If Not Target.Value = "" Then _
    Target.Offset(0, 1) = Evaluate("=WORKDAY(" & CDbl(Target.Value) & ",--(WEEKDAY(" & CDbl(Target.Value) & ",2)>5))")
  
End Sub

Teşekkürler Necdet Bey