DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Vardar07 abi #18 deki mesajima bakarsaniz sevinirim ornek dosya da attim..
vardar07 hocam alicimri bey bir çalışma yapmış birden fazla mazeret girebiliyorum ve herkesi icmale taşıyıp mazereti olmayanlara 1 atıyor benım ıstedıgım gıbı ancak eksık kısmı;
sizin yaptıgınız dosyadaki gibi bir sonrakı aya sarkanları dıger ayı secınce aktarmıyor.. size zahmet onu ayarlarsanız dosya tam benım ıstedıgım gıbı olacak..
vardar hocam bu kırmızı ile kapalı alanlara raporlu olanra r yıllık izinde olanlara yi resmi tatile rt şeklinde ayarlama durumu var mıdır acaba?
vardar hocam bu şekilde yapmanın bir olasılıgı varmı acaba?
vardar hocam bu şekilde yapmanın bir olasılıgı varmı acaba?
bir sonraki aya sarkan tarihleri atmıyor..son olarak buna bakabilirmisiniz.
Sayın vardar07
Yardım dosyasına vba şifresi koymuşsunuz.
![]()
#31 nolu mesajdan kontrol ediniz.
vardar07 abim dosyayı denedim 1. ayı yaptım harika çalışıyor fakat 2. ayı yaptığımda sayfada birçok hata çıkıyor. örnek dosyayı yükledim yapmış olduğum denemeyi bakabilirmisin..
abi birde şifre koymussun galiba şifre nedir abi yardımcı olacak diğer arkadaşlar soruyor..
Sub aktar()
On Error Resume Next
Application.ScreenUpdating = False
Set n = Sheets("İZİNLİLER"): Set i = Sheets("İCMAL")
a = i.Range("b1048576").End(3).Row
If a > 5 Then i.Range("A6:AL" & a).ClearContents
i.Range("G6:AK" & a).Interior.ColorIndex = 2
For mv = 5 To n.Range("B1048576").End(3).Row
son = i.Range("B1048576").End(3).Row + 1
xa = i.Cells(1, "E") & "." & Format(i.Cells(1, "C"), "0#")
m = Len(n.Cells(mv, 7))
If n.Cells(mv, 2) = "" Then GoTo sn
If n.Cells(mv, 2) <> "" And n.Cells(mv, 6) = "" Then
a = i.Cells(1, "E") & "." & i.Cells(1, "C") & "." & 1
sgun = Day(DateSerial(Year(a), Format(Month(a), "0#") + 1, 0))
sade
GoTo sn
End If
If n.Cells(mv, "G") <> "" Then
If m > 10 Then
If m > 5 Then mm = 1
If m > 11 Then mm = 2
If m > 22 Then mm = 3
If m > 33 Then mm = 4
v = v + 1
If v > mm Then: v = 0: GoTo sn
Call ilk_son
GoTo 5
Else
If Year(n.Cells(mv, "G")) < Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "G")) = i.Cells(1, "C") Then
ilkt = Year(n.Cells(mv, "G")) & "." & Format(Month(n.Cells(mv, "G")), "0#")
sont = Year(n.Cells(mv, "G")) & "." & Format(Month(n.Cells(mv, "G")), "0#")
ElseIf Year(n.Cells(mv, "G")) < Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "H")) = i.Cells(1, "C") Then
ilkt = Year(n.Cells(mv, "H")) & "." & Format(Month(n.Cells(mv, "H")), "0#")
sont = Year(n.Cells(mv, "H")) & "." & Format(Month(n.Cells(mv, "H")), "0#")
ElseIf Year(n.Cells(mv, "G")) = Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "G")) = i.Cells(1, "C") _
And Month(n.Cells(mv, "H")) = i.Cells(1, "C") Then
ilkt = Year(n.Cells(mv, "G")) & "." & Format(Month(n.Cells(mv, "G")), "0#")
sont = Year(n.Cells(mv, "H")) & "." & Format(Month(n.Cells(mv, "H")), "0#")
ElseIf Year(n.Cells(mv, "G")) = Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "G")) = i.Cells(1, "C") Then
ilkt = Year(n.Cells(mv, "G")) & "." & Format(Month(n.Cells(mv, "G")), "0#")
sont = Year(n.Cells(mv, "G")) & "." & Format(Month(n.Cells(mv, "G")), "0#")
ElseIf Year(n.Cells(mv, "G")) = Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "H")) = i.Cells(1, "C") Then
ilkt = Year(n.Cells(mv, "H")) & "." & Format(Month(n.Cells(mv, "H")), "0#")
sont = Year(n.Cells(mv, "H")) & "." & Format(Month(n.Cells(mv, "H")), "0#")
End If
End If
5:
If ilkt = xa Or sont = xa Then
i.Cells(son, 1) = WorksheetFunction.Max(i.Range("A2:A" & son)) + 1
i.Cells(son, 2) = n.Cells(mv, 2)
i.Cells(son, 3) = n.Cells(mv, 3)
i.Cells(son, 4) = n.Cells(mv, 4)
i.Cells(son, 5) = n.Cells(mv, 5)
i.Cells(son, 6) = n.Cells(mv, 6)
tgun = Day(DateSerial(Year(sont), Month(sont) + 1, 0))
i.Range(i.Cells(son, 7), i.Cells(son, tgun + 6)) = 1
If n.Cells(mv, 7) <> "" And n.Cells(mv, 8) <> "" Then
If m > 10 Then
If m > 4 Then mm = 1
If m > 11 Then mm = 2
If m > 22 Then mm = 3
If m > 33 Then mm = 4
15:
vv = vv + 1
i.Cells(son, 5) = vv
If vv > mm Then: vv = 0: GoTo sn
Call buyuk: GoTo 15
Else
If Year(n.Cells(mv, "G")) < Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "G")) = i.Cells(1, "C") Then 'Yılküçük ayrılma eşit c1e
sgun = Day(DateSerial(Year(n.Cells(mv, "G")), Month(n.Cells(mv, "G")) + 1, 0))
ilksut = Day(n.Cells(mv, "G")) + 6
sonsut = sgun + 6
ElseIf Year(n.Cells(mv, "G")) < Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "H")) = i.Cells(1, "C") Then 'Yılküçük başlama eşit c1e
igun = Day(DateSerial(Year(n.Cells(mv, "G")), Month(n.Cells(mv, "G")), 1))
ilksut = igun + 6
sonsut = Day(n.Cells(mv, "H")) + 5
ElseIf Year(n.Cells(mv, "G")) = Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "G")) = Month(n.Cells(mv, "H")) _
And Month(n.Cells(mv, "G")) = i.Cells(1, "C") Then 'yıl eşit ay eşit c1
ilksut = Day(n.Cells(mv, "G")) + 6
sonsut = Day(n.Cells(mv, "H")) + 5
ElseIf Year(n.Cells(mv, "G")) = Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "G")) < Month(n.Cells(mv, "H")) And Month(n.Cells(mv, "G")) = i.Cells(1, "C") Then 'yıleşit ay küçük
sgun = Day(DateSerial(Year(n.Cells(mv, "G")), Month(n.Cells(mv, "G")) + 1, 0))
ilksut = Day(n.Cells(mv, "G")) + 6
sonsut = sgun + 6
ElseIf Year(n.Cells(mv, "G")) = Year(n.Cells(mv, "H")) And Month(n.Cells(mv, "G")) < Month(n.Cells(mv, "H")) And Month(n.Cells(mv, "H")) = i.Cells(1, "C") Then 'yıl eşit ay büyük
igun = Day(DateSerial(Year(n.Cells(mv, "H")), Month(n.Cells(mv, "H")), 1))
ilksut = igun + 6
sonsut = Day(n.Cells(mv, "H")) + 5
End If
i.Range(i.Cells(son, 7), i.Cells(son, tgun + 6)) = 1
If ilksut > sonsut Then
Else
i.Range(i.Cells(son, ilksut), i.Cells(son, sonsut)) = ""
i.Range(i.Cells(son, ilksut), i.Cells(son, sonsut)).Interior.ColorIndex = 3
End If
i.Cells(son, "AL") = WorksheetFunction.Sum(i.Range("G" & son & ".AK" & son))
End If
End If
End If
End If
sn:
ilkt = Empty: sont = Empty: v = 0
Next mv
MsgBox "AKTARMA BİTTİ..."
End Sub