Makro ile =EĞER(B4+C4<60;B4+C4;60)

[omeryılmaz]

Makro ile =EĞER("B3:B65000")=30 ise (B4+C4<60;B4+C4;60)

Değerli Üstadlarım
Yandaki D,G,J,M,P,S sütunlarda mevcut formü" Makro ile =EĞER("B3:B65000")=30 ise (B4+C4<60;B4+C4;60)
makroyla yapmak

 

[halit3]

Değerli Üstadlarım
Yandaki D,G,J,M,P,S sütunlarda mevcut formü" =EĞER(B4+C4<60;B4+C4;60)" makroyla yapmak

bu kodu denermisiniz.

Private Sub CommandButton1_Click()
sut = 2
For j = 1 To 6
For i = 3 To WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("B3:B65000")) + 2
If sut > 3 Then
Worksheets(ActiveSheet.Name).Cells(i, sut + 1).Value = Worksheets(ActiveSheet.Name).Cells(i, sut - 1).Value - Worksheets(ActiveSheet.Name).Cells(i, sut).Value
End If
If Worksheets(ActiveSheet.Name).Cells(i, 2).Value + Worksheets(ActiveSheet.Name).Cells(i, sut + 1).Value < 60 Then
Worksheets(ActiveSheet.Name).Cells(i, sut + 2).Value = Worksheets(ActiveSheet.Name).Cells(i, 2).Value + Worksheets(ActiveSheet.Name).Cells(i, sut + 1).Value
Else
Worksheets(ActiveSheet.Name).Cells(i, sut + 2).Value = 60
End If
Next i
sut = sut + 3
Next j
MsgBox "işlem tamam"
End Sub

 

[Orion1]

Dosyanız ektedir.

Private Sub CommandButton1_Click()
Dim alan As Range, hcr As Range, sat As Long
sat = Sheets("İzin Takip").Cells(65536, "B").End(xlUp).Row
Set alan = Sheets("İzin Takip").Range("D3:D" & sat & ",G3:G" & _
sat & ",J3:J" & sat & ",M3:M" & sat & ",P3:P" & sat)
For Each hcr In alan
    If Sheets("İzin Takip").Range("B" & hcr.Row).Value + hcr.Offset(0, -1).Value < 60 Then
        deg = Sheets("İzin Takip").Range("B" & hcr.Row).Value + hcr.Offset(0, -1).Value
        hcr.Value = deg
        Else
        hcr.Value = 60
    End If
Next
MsgBox "İşlem Bitmiştir." & vbLf & vbLf _
& "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[omeryılmaz]

Makro ile =EĞER("B3:B65000")=30 ise (B4+C4<60;B4+C4;60)

Değerli Üstadlarım Özür dilerim.. Sayfaya uyguladıktan sonra hatamın farkına vardım aşağıdaki gibi makro değişikliği yapabilirmiyiz...
D,G,J,M,P,S sütunlarda mevcut formü"
=EĞER ("B3:B65000")=20 ise (B4+C4<40;B4+C4;40)"
=EĞER ("B3:B65000")=30 ise (B4+C4<60;B4+C4;60)" makroyla yapmak

 

[omeryılmaz]

Makro ile =EĞER("B3:B65000")=30 ise (B4+C4<60;B4+C4;60)

Dün sormuş olduğum soruya vermiş olduğunuz yanıt için şükranlarımı sunuyorum.

Ancak; Soruyu hatalı sorduğumun farkına sonradan vardım.
Çünkü; Eğer personel 10 yıldan az hizmet süresi varsa kullanmadığı izinlerinin toplamı 40 günü geçmemeli

Makro ile =EĞER("B3:B65000")=20 ise (B4+C4<40;B4+C4;40)

eğer Hizmet süresi 10 yıldan fazla ise kullanmadığı izinlerin toplamı 60 günü geçmemeli...

Makro ile =EĞER("B3:B65000")=30 ise (B4+C4<60;B4+C4;60)

 

[halit3]

Dün sormuş olduğum soruya vermiş olduğunuz yanıt için şükranlarımı sunuyorum.

Ancak; Soruyu hatalı sorduğumun farkına sonradan vardım.
Çünkü; Eğer personel 10 yıldan az hizmet süresi varsa kullanmadığı izinlerinin toplamı 40 günü geçmemeli

Makro ile =EĞER("B3:B65000")=20 ise (B4+C4<40;B4+C4;40)

eğer Hizmet süresi 10 yıldan fazla ise kullanmadığı izinlerin toplamı 60 günü geçmemeli...

Makro ile =EĞER("B3:B65000")=30 ise (B4+C4<60;B4+C4;60)

bu kodu denermisiniz.

Private Sub CommandButton1_Click()
sut = 2
For J = 1 To WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:IV1")) + 1
For i = 3 To WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("B3:B65000")) + 2
If sut > 3 Then
Worksheets(ActiveSheet.Name).Cells(i, sut + 1).Value = Worksheets(ActiveSheet.Name).Cells(i, sut - 1).Value - Worksheets(ActiveSheet.Name).Cells(i, sut).Value
End If
If Worksheets(ActiveSheet.Name).Cells(i, 2).Value = 30 Then
If Worksheets(ActiveSheet.Name).Cells(i, 2).Value + Worksheets(ActiveSheet.Name).Cells(i, sut + 1).Value < 60 Then
Worksheets(ActiveSheet.Name).Cells(i, sut + 2).Value = Worksheets(ActiveSheet.Name).Cells(i, 2).Value + Worksheets(ActiveSheet.Name).Cells(i, sut + 1).Value
Else
Worksheets(ActiveSheet.Name).Cells(i, sut + 2).Value = 60
End If
End If
If Worksheets(ActiveSheet.Name).Cells(i, 2).Value = 20 Then
If Worksheets(ActiveSheet.Name).Cells(i, 2).Value + Worksheets(ActiveSheet.Name).Cells(i, sut + 1).Value < 40 Then
Worksheets(ActiveSheet.Name).Cells(i, sut + 2).Value = Worksheets(ActiveSheet.Name).Cells(i, 2).Value + Worksheets(ActiveSheet.Name).Cells(i, sut + 1).Value
Else
Worksheets(ActiveSheet.Name).Cells(i, sut + 2).Value = 40
End If
End If
Next i
sut = sut + 3
J = J + 3
Next J
MsgBox "işlem tamam"
End Sub