Haftalara göre saatlerin dağıtımı

[sahika51]

Herkese iyi günler bir puantaj programı yapmaya çalışıyorum. Program bir kaç parçadan oluşuyor. İnşallah bitirebilirsem burada paylaşacağım. Takıldığım bir yer var. Burda anlatması biraz zor. programın içerisinde örnek vererek anlattım. yardımlarınızı bekliyorum.

 

[Ömer BARAN]

Merhaba.

Dosyayı ve kod'u hatırlıyor gibiyim.
Sanırım silmekten bahsettiğiniz veriler G:M sütun aralığında olmak üzere; 15, 20, 25, ..., 55, 60'ıncı satırdaki veriler değil mi?

Eğer öyle ise;
-- mevcut kod, belirttiğim satırlarda veri yazıldığında/silindiğinde, yazılı değerleri, değer olan sütunlarda olmak ve 1 alttaki satıra yazılanların toplamı 15'i geçmemek, kalan değerler toplamı 15'den büyükse de 15'in üstünde kalan kısmının 2 alttaki satıra dağıtılmasını sağlıyor iken
(burada silme/yazma işlemi sırasında satır toplamı değişiyor)
-- bu kez yukarıda belirttiğim yöntemle gerçekleşen dağıtma işleminin yapılmadan önce, silinen değerin kendi satırında başka hücrelere eklenmesinin ardından dağıtma işlemine geçilmesini (anladığım kadarıyla burada ise silme işlemi yapıldığında toplamın değişmemesi anlamı çıkıyor)
istiyorsunuz doğru mudur?

Sorun/istek: Veriyi silmek için mi sildiğiniz (satır toplamı, silinen değer kadar azalıyor), yoksa diğer sütunlara eklenmesi için mi sildiğiniz (toplamın değişmemesini istediğiniz) nasıl anlaşılacak. Yani bu karar nasıl, hangi kritere göre verilecek acaba?

Fikir: Ücretlendirme türünü belirleyen D sütununda ilgili satıra bir değer/işaret eklenip karar bu değerin/işaretin varlığına/yokluğuna göre;
-- bu işaret/değer varsa son istediğiniz işlemin (satırın toplamı değişmeden, silinen değerin diğer sütunlara aktarıması)
-- bu işaret/değer yoksa da gerçek silme (toplamın azalması), yani mevcut kod'un çalışması
sağlanabilir gibi geldi bana.

 

[sahika51]

--Sildiğim verinin diğer hücrelere eklenmesini istemiyorum. Dikkat ederseniz birinci örnek ve istediğim örnekteki toplamlar farklı. Maaş karşılığı sizin yukarda dediğinz gibi 15 i geçmemek üzere 1. satıra dağıtıtı 2 satıra ise kalan 4 ü dağıttı
--Tablo her ay değiştiğinde günlerin yeri değişebiliyor. Ben burada G:M sütunundaki kuralın aynısını P:AX arasındaki haftalara uygulayabilmek istiyorum. . Ancak Her haftayı bağımsız olarak olarak düşünmek gerekiyor.
-- Örneğimde 2018 Eylül ayı için. S:V 1. Hafta Y:AC ikinci hafta AF:AJ 3. Hafta AM:AQ 4. Hafta belki başka aylarda AT:AX 5. hafta olabilir.
-- Tabi burda farklı bir aya geçtiğimizde haftalarda kaymalar olacaktır.

 

[Ömer BARAN]

Şimdi bilgisayar başından kalkmam gerekiyor.
Verdiğiniz örnekte BT sütunundaki TOPLAM sayıları aynı olunca toplamın değişmemesi gibi anlamıştım.

Sorunuzu anladım, daha sonra bakmaya çalışırım.
Belki de başka bir üye o zamana kadar çözüm öneresinde bulunur.

 

[sahika51]

Ok. Teşekkür ederim

 

[Ömer BARAN]

Tekrar merhaba.
Mevcut yapıda, G:M sütun aralığına veri girişi yapılıp, kod tarafından gerekli dağıtım işlemi yine G:M sütun aralığına yapılıyor.
Ardından da formüller kullanılarak bu sonuçlar diğer haftalara aynen yazılıyor.
İstediğiniz son değişiklikle birlikte; artık G:M arasını veri girişi olarak kullanmak yerine her haftaya veri girişini kendi sütununda ve yine 15, 20, 25,... satırlarda mı yapmak istiyorsunuz?
Yani artık veri girişi için, G:M sütun aralığını değil, günlere ait sütunları mı (P:AX) kulanacaksınız?
.

 

[sahika51]

G: M sütünundaki değerleri aynen P:Ax te kullanılmasını istiyorum

 

[Ömer BARAN]

Önce; belgede G:M sütunlarındaki verileri ve P:AX sütunlarındaki formülleri temizleyin.

Belgenizde uygun boş satır olarak 66'ncı satırı kullanlmasını uygun gördüm . Buna göre;
-- N66 hücresine yandaki formülü uygulayın =KAÇINCI(D2;$P$12:$AX$12;0)+15
-- P66 hücresine =EĞER(P12="";"";HAFTASAY(P12;2)-HAFTASAY($A$2;2)+1) formülünü uygulayıp sağa doğru AX hücresine kadar kopyalayın.
-- Devamsızlık sayfasının kod bölümündeki Private Sub Worksheet_Change(ByVal Target As Range) kodunu aşağıdakiyle değiştirin.

Sonuç:
-- G:M sütun aralığına yazılan değerler sağ tarafta ilgili hücrelere aynen yazdırılır.
-- P:AX sütun aralığında yazılan veriler ise ilgili hafta kendi içerisinde aynı kurallara (toplam 15 vs) göre değerlendirilerek dağıtım yapılır.

Private Sub Worksheet_Change(ByVal Target As Range)
If Int(Target.Row / 5) <> Target.Row / 5 Then Exit Sub
sonsut = Sheets("Devamsızlık").[N66].Value

If Target.Column >= 7 And Target.Column <= 13 Then
hb = 7: hs = 13
      
        ustalan = Cells(Target.Row, hb).Address(0, 0) & ":" & Cells(Target.Row, hs).Address(0, 0)
        altalan = Cells(Target.Row + 1, hb).Address(0, 0) & ":" & Cells(Target.Row + 2, hs).Address(0, 0)
        Range(altalan).ClearContents
      
        Range(Cells(Target.Row, "P"), Cells(Target.Row + 4, "AX")).ClearContents
        If WorksheetFunction.Sum(Range(ustalan)) = 0 Then Exit Sub

        If WorksheetFunction.Sum(Range(ustalan)) < 15 Then
            For sut = hb To hs
                Cells(Target.Row + 1, sut) = Cells(Target.Row, sut)
            Next
        Else
30:         For sut = hb To hs
                If Cells(Target.Row, sut) > 0 And Cells(Target.Row + 1, sut) + 1 <= Cells(Target.Row, sut) _
                    And WorksheetFunction.Sum(Range(Cells(Target.Row + 1, hb), Cells(Target.Row + 1, hs))) + 1 <= 15 _
                    Then Cells(Target.Row + 1, sut) = Cells(Target.Row + 1, sut) + 1
            Next
            If WorksheetFunction.Sum(Range(Cells(Target.Row + 1, hb), Cells(Target.Row + 1, hs))) < 15 Then GoTo 30
  
            For sut = hb To hs
                If Cells(Target.Row, sut) > 0 And _
                Cells(Target.Row, sut) - Cells(Target.Row + 1, sut) > 0 Then _
                Cells(Target.Row + 2, sut) = Cells(Target.Row, sut) - Cells(Target.Row + 1, sut)
            Next
        End If

Range(Cells(Target.Row, 16), Cells(Target.Row + 2, sonsut)).ClearContents
    For ssut = 16 To sonsut
        If Cells(14, ssut) = "Pazartesi" Then Cells(Target.Row, ssut) = Cells(Target.Row, "G")
        If Cells(14, ssut) = "Salı" Then Cells(Target.Row, ssut) = Cells(Target.Row, "H")
        If Cells(14, ssut) = "Çarşamba" Then Cells(Target.Row, ssut) = Cells(Target.Row, "I")
        If Cells(14, ssut) = "Perşembe" Then Cells(Target.Row, ssut) = Cells(Target.Row, "J")
        If Cells(14, ssut) = "Cuma" Then Cells(Target.Row, ssut) = Cells(Target.Row, "K")
        If Cells(14, ssut) = "Cumartesi" Then Cells(Target.Row, ssut) = Cells(Target.Row, "L")
        If Cells(14, ssut) = "Pazar" Then Cells(Target.Row, ssut) = Cells(Target.Row, "M")
    Next
  
    Exit Sub
End If

If Target.Column < 16 Or Target.Column > sonsut Then Exit Sub

hb = WorksheetFunction.Match(Cells(66, Target.Column), [P66:AX66], 0) + 15
hs = hb - 1 + WorksheetFunction.CountIf([P66:AX66], Cells(66, Target.Column))
ustalan = Cells(Target.Row, hb).Address(0, 0) & ":" & Cells(Target.Row, hs).Address(0, 0)
altalan = Cells(Target.Row + 1, hb).Address(0, 0) & ":" & Cells(Target.Row + 2, hs).Address(0, 0)

Range(altalan).ClearContents
If WorksheetFunction.Sum(Range(ustalan)) = 0 Then Exit Sub

If WorksheetFunction.Sum(Range(ustalan)) < 15 Then
    For sut = hb To hs
        Cells(Target.Row + 1, sut) = Cells(Target.Row, sut)
    Next
Else
20: For sut = hb To hs
        If Cells(Target.Row, sut) > 0 And Cells(Target.Row + 1, sut) + 1 <= Cells(Target.Row, sut) _
            And WorksheetFunction.Sum(Range(Cells(Target.Row + 1, hb), Cells(Target.Row + 1, hs))) + 1 <= 15 _
            Then Cells(Target.Row + 1, sut) = Cells(Target.Row + 1, sut) + 1
    Next
    If WorksheetFunction.Sum(Range(Cells(Target.Row + 1, hb), Cells(Target.Row + 1, hs))) < 15 Then GoTo 20
  
    For sut = hb To hs
        If Cells(Target.Row, sut) > 0 And _
            Cells(Target.Row, sut) - Cells(Target.Row + 1, sut) > 0 Then _
            Cells(Target.Row + 2, sut) = Cells(Target.Row, sut) - Cells(Target.Row + 1, sut)
    Next
End If
End Sub

 

[sahika51]

Ömer bey ne kadar teşekkür etsem azdır. Harika olmuş ellerinize sağlık

 

[Ömer BARAN]

Kod'un baş kısmında aşağıda kırmızı renklendirdiğim kısımları/satırları eklemenizde yarar var.

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Or Target.Row < 15 Then Exit Sub
If Int(Target.Row / 5) <> Target.Row / 5 Or Target.Column < 7 Or Target.Column > 50 Then Exit Sub
sonsut = Sheets("Devamsızlık").[N66].Value
If Target.Column > sonsut Or (Target.Column > 13 And Target.Column < 16) Then Exit Sub

If Target.Column >= 7 And Target.Column <= 13 Then

 

[sahika51]

 

[Ömer BARAN]

Kolay gelsin.