• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Personel puantaj makrosu sorunu..

abi evet o sorunda duzeldı sayende ilk defa 300 kısılık verı gırerek dosyayı denedım 1. ay ıcın ocak ayı harıka calısıyor.

gırdıgım verılerle subat ayını yapmaya çalışıyorum fakat icmal kısmına herkesi taşımıyor..

olması gereken şubatı seçince icmale herkesi taşıması ve şubat ayında mazereti olmayanları 1 ile doldurması.

şimdi denedim bütün personeli sarkan aylara hepsini taşımıyor bakabilirmisin..
 
Malesef uğraşamıyacağım.
 
Abi dosya cok guzel oldu bitti
Sadece o sorun kaldi son kez bakiver.
Rica ediyorum.
 
Son kez bu günün hatırına bundan sonra hiçbir konunuza ilgi duymayacağım.Bunca emek boşa gitmesin diye son defa cevap veriyorum. buyuk kod bloğundaki aşağıdaki satırları diğerinle değiştirin.
Kod: 
ElseIf Year(mnv) = Year(mvn) And Month(mnv) < Month(mvn) And Month(mvn) = i.Cells(1, "C") Then
 ilksut = Int(Day(DateSerial(Year(mvn), Month(mnv), 1))) + 6: sonsut = Int(Day(mvn)) + 5
If sonsut = 6 Then sonsut =37

Kod: 
ElseIf Year(mnv) = Year(mvn) And Month(mnv) < Month(mvn) And Month(mvn) = i.Cells(1, "C") Then
 ilksut = Int(Day(DateSerial(Year(mvn), Month(mnv), 1))) + 6: sonsut = Int(Day(mvn)) + 5
If sonsut = 6 Then sonsut = ilksut
 
abi sagolasın #44 de verdiğin ilk kodu aynı mesajdaki 2. kodlamı değiştireyim tam anlamadım.. denedim ama olmadı malesef şu kodları birlerştirip dosyayı yüklermisin rica etsem..sarkan aylara gene mazeretsizleri atmıyor malesef.. emeğine sağlık çok meşgul ettim seni. anlamayana bu işler o kadar karışık ki özür dilerim ..
 
Son düzenleme:
Bende sorunsuz çalışıyor.Yanlış anlamayın okuduğunuzu yorumlama sorunu var galiba. Kodların olduğu yeri açın bilmiyorsanız excel açıkken alt+F11 tuşlrına beraber basınca karşınıza gelen pencere de sub buyuk() diye başlayan kısımda 44 deki 1 koddaki satırları bulup sileceksiniz alttaki kodu sildiğiniz yere yapıştıracaksınız.Hepsi bu. Sizin galiba balık tutmaya niyetiniz yok hazır balıkları yemeye çalışır gibi durumunuz var. Yaşım 55 emekliyim sizinkini bilmiyorum. Birşeylerin nasıl yapıldığını öğrenin aksi halde hep ortada kalırsınız.
 
vardar07 abim sorunu hallettim sanırım ellerine sağlık sayın abim hakkını helal et..

izinliler kısmındaki F sütunu icmale F sutununu cıkmasını istemesem kodlardan hangisini sileyim abi..
Bu sekilde gereksiz bilgiler geliyor bunu da yaptımmı tamam.
işimi ne kadar kolaylastırdı bılemezsın..
 
Son düzenleme:
vardar07 abim sorunu hallettim sanırım ellerine sağlık sayın abim hakkını helal et..

izinliler kısmındaki F sütunu icmale F sutununu cıkmasını istemesem kodlardan hangisini sileyim abi..
 
Arkadaşlar 29 çeken aylarda ve 31 çeken aylarda icmalde günler kısmına manuel olarak 1 eklediğimde veya sutundaki 1 i sildiğimde otomatik toplam kısmının değiştirmesi için kodların düzenlenmesi gerekiyor..
Kodlara nasıl bir düzenleme yapabiliriz.. Dosya yapısını formülleri bozmadan..
 
Son düzenleme:
Üyemizin isteği üzerine dosya silinmiştir. (Özel bilgi içerdiği bildirildi.)

İşlemi Yapan; Korhan AYHAN
 
Biz arkadaşlardan gerçek isimli dosyalarını istemiyoruuz. Üye arkadaşlar dosyayı ekleyince yazılanlara göre yardımcı oluyoruz. Dosya eklerken arkadaşlar daha dikkatli olursa iyi olur.

Not :Dosyanın neticesi için geri dönüş yapılırsa memnun oluruz.
 
dosyanın son hali bu sekılde tek ıstedıgım kaldı onu yapamadım; tek sorunu otomatık toplamda yapmıs oldugumuz =topla(g6:ak6) komutunu uyguluyorum ancak aktar yapınca sılınıyor sıze zahmet buna bı bakarsanız sevınırım..
 
Son düzenleme:
Dosyayı denedim. Hiçbir sorun yok. Ay değiştirip denerseniz sonucu birdaha deneyin. Kod içinde otomatik topluyor.Dosya içerisinde belirttiğiniz "İCMAL bölümünde de AL6 hücresine =toplam(g6:ak6) yazarsanız hücrelere yazdığınız 1 leri otomatik toplama yapacaktır." Kısmı yok ve gereksizdir. Formülleri görmeyeceksiniz.
 
abım ellerıne saglık dosyada sıkıntı yok zaten benım ıstegım =topla(g6:ak6) komutunu butun sutunlara ekleyerek aktarma işemınden sonra manuel olarak ıslem yapmam gerekırse 1 ekledıgımde veya 1 sıldıgımde toplam kısmının otomatık degısmesını ıstıyorum...
 
Deneme modulü içindeki kodların tamamını silip aşağıdakileri ekleyin.
Kod: 
Dim i, n As Worksheet
Dim mv As Variant, sat As Integer, ilkt, sont, son, sgun, v, vv As Integer, xa, xb As Variant
Sub syfsec()
MsgBox "YIL VE AY SEÇMEDİNİZ."
Sheets("İCMAL").Select
End Sub
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
With Sheets("İCMAL")
a = .Cells(1, "E") & "." & .Cells(1, "C") & "." & 1
igun = Day(DateSerial(Year(a), Format(Month(a), "0#"), 1))
sgun = Day(DateSerial(Year(a), Format(Month(a), "0#") + 1, 0))
.Range("G2:AK5").ClearContents
a = 7
For vm = igun To sgun
.Cells(2, a) = vm
a = a + 1
Next
End With

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)
   tgun = Day(DateSerial(Year(sont), Month(sont) + 1, 0))
 i.Range(i.Cells(son, 7), i.Cells(son, sgun + 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


      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))
i.Cells(son, "AL").FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
End If
End If
End If
End If
sn:
ilkt = Empty: sont = Empty: v = 0
Next mv
MsgBox "AKTARMA BİTTİ..."
End Sub
Sub ilk_son()
Set n = Sheets("İZİNLİLER"): Set i = Sheets("İCMAL")
a = Mid(n.Cells(mv, "G"), 1, 10): b = Mid(n.Cells(mv, "H"), 1, 10)
    c = Mid(n.Cells(mv, "G"), 12, 10): d = Mid(n.Cells(mv, "H"), 12, 10)
    e = Mid(n.Cells(mv, "G"), 23, 10): f = Mid(n.Cells(mv, "H"), 23, 10)
    G = Mid(n.Cells(mv, "G"), 34, 10): h = Mid(n.Cells(mv, "H"), 34, 10)
basla:
If v = 1 Then mnv = a: mvn = b
If v = 2 Then mnv = c: mvn = d
If v = 3 Then mnv = e: mvn = f
If v = 4 Then mnv = G: mvn = h

If Year(mnv) < Year(mvn) And Month(mnv) = i.Cells(1, "C") Then '1
ilkt = Year(mnv) & "." & Format(Month(mnv), "0#")
sont = Year(mnv) & "." & Format(Month(mnv), "0#")
sgun = Day(DateSerial(Year(mnv), Month(mnv) + 1, 0))
'---------------

ElseIf Year(mnv) < Year(mvn) And Month(mvn) = i.Cells(1, "C") Then '2
igun = Day(DateSerial(Year(mvn), Month(mvn), 1))
ilkt = igun
sont = Year(mvn) & "." & Format(Month(mvn), "0#")
'------------------------
ElseIf Year(mnv) = Year(mvn) And Month(mnv) < Month(mvn) And Month(mnv) = i.Cells(1, "C") Then '3
sgun = Day(DateSerial(Year(mnv), Month(mnv) + 1, 0))
ilkt = Year(mnv) & "." & Format(Month(mnv), "0#")
sont = sgun
'---------------------------
ElseIf Year(mnv) = Year(mvn) And Month(mnv) < Month(mvn) And Month(mvn) = i.Cells(1, "C") Then '4
ilkt = Year(mvn) & "." & Format(Month(mvn), "0#")
sont = Year(mvn) & "." & Format(Month(mvn), "0#")
'----------------------------------------------
ElseIf Year(mnv) = Year(mvn) And Month(mnv) = Month(mvn) And Month(mvn) = i.Cells(1, "C") Then '7
ilkt = Year(mnv) & "." & Format(Month(mnv), "0#")
sont = Year(mvn) & "." & Format(Month(mvn), "0#")

Else
If v <= 4 Then
v = v + 1
GoTo basla
End If
End If
End Sub

Sub buyuk()
Set n = Sheets("İZİNLİLER"): Set i = Sheets("İCMAL")
sat = son
    a = Mid(n.Cells(mv, "G"), 1, 10): b = Mid(n.Cells(mv, "H"), 1, 10)
    c = Mid(n.Cells(mv, "G"), 12, 10): d = Mid(n.Cells(mv, "H"), 12, 10)
    e = Mid(n.Cells(mv, "G"), 23, 10): f = Mid(n.Cells(mv, "H"), 23, 10)
    G = Mid(n.Cells(mv, "G"), 34, 10): h = Mid(n.Cells(mv, "H"), 34, 10)
basla:
If vv = 1 Then mnv = a: mvn = b
If vv = 2 Then mnv = c: mvn = d
If vv = 3 Then mnv = e: mvn = f
If vv = 4 Then mnv = G: mvn = h
xb = Format(mnv, "yyyy.mm")

If Year(mnv) < Year(mvn) And Month(mnv) = i.Cells(1, "C") Then '1
ilksut = Int(Day(mnv)) + 6: sonsut = Int(Day(DateSerial(Year(mnv), Month(mnv) + 1, 0))) + 6

ElseIf Year(mnv) < Year(mvn) And Month(mvn) = i.Cells(1, "C") Then '2
ilksut = Int(Day(DateSerial(Year(mvn), Month(mvn), 1))) + 6: sonsut = Int(Day(mvn)) + 5

ElseIf Year(mnv) = Year(mvn) And Month(mnv) < Month(mvn) And Month(mnv) = i.Cells(1, "C") Then '3
 ilksut = Int(Day(mnv)) + 6: sonsut = Int(Day(DateSerial(Year(mnv), Month(mnv) + 1, 0))) + 6

ElseIf Year(mnv) = Year(mvn) And Month(mnv) < Month(mvn) And Month(mvn) = i.Cells(1, "C") Then
 ilksut = Int(Day(DateSerial(Year(mvn), Month(mnv), 1))) + 6: sonsut = Int(Day(mvn)) + 5
If ilksut > sonsut Then GoTo bitti

ElseIf Year(mnv) = Year(mvn) And Month(mnv) = Month(mvn) And Month(mvn) = i.Cells(1, "C") Then '5
ilksut = Int(Day(mnv)) + 6:      sonsut = Int(Day(mvn)) + 5
 End If

  i.Range(i.Cells(sat, ilksut), i.Cells(sat, sonsut)) = ""
 i.Range(i.Cells(sat, ilksut), i.Cells(sat, sonsut)).Interior.ColorIndex = 3
bitti:
'i.Cells(son, "AL") = WorksheetFunction.Sum(i.Range("G" & son & ".AK" & son))
i.Cells(son, "AL").FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
 End Sub
Sub sade()

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.Range(i.Cells(son, 7), i.Cells(son, sgun + 6)) = 1
  'i.Cells(son, "AL") = WorksheetFunction.Sum(i.Range("G" & son & ".AK" & son))
  i.Cells(son, "AL").FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst