nöbeti PUANTAJ CETVELİ ne aktarma

[attrd]

Varsayılan nöbeti PUANTAJ CETVELİ ne çevirme
Arkadaşlar exelde 1 sayfada nöbet listem var 2 sayfada puantaş listem var örneğin ayın 5 de isim ali veli selin yazıyorsa puantaş cetvelinde de alinin velinin ve selinin karşısındaki ayın 5 gününe 24 veya 8 yazmasını istiyorum bir günde en az 3 kişi nöbet tutuyor yine ayın diğer günleri de listede kim varsa puantaj cetvelinde aynı güne 24 yazmalı veya 8 yazmalı ben formda bulamadım yardımcı olurmusunuz . örnek dosyam var fakat ekleyemedim bide. saygılarımla . DOSYAMI EKLEDİM LİNK = http://dosya.web.tr/OPBBnK

 

[systran]

Puantaj sayfasındaki isimlerde hata var.
YILDIRIRM gibi yazım yanlışları ve bazı isimlerin sonunda boşluk var. Bunları nöbet listesi sayfasındaki gibi listeden almanız yanlışların önüne geçecektir.
aşağıdaki kodları module içine yazıp çalıştırn.

Sub aktar()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
deger = 8  'Nöbet saati
Sayfa2.Range("M6:AQ17").ClearContents
For x = 1 To 31
    For y = 10 To 12        'J=10, K=11, L=12 sütun
       tmp1 = Sayfa1.Cells(2 * x + 1, y)    'H3 H61 Arası 2  şer adımla ilerle
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
    Next y
Next x
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[attrd]

Hocam

hocam cok cok teşekkur ederim elinize sağlık

 

[systran]

öncelikle cok cok tesekkur ederim cok ısıme yaradı kod ıcındekı 8 sayısını 24 yaptım 24 saat olarak puantaja attı.bıde 12 kısılık ısım lıstesınıde sızın kod uzerınden arttırdım baska personel gelebılırdıye o da oldu fakat benım sucum var ben mesela ayın 1. günü 3 kısıyı gosterdım fakat sizinde gördugunuz gıbı hergünde 6 personel nöbet tutabılıyo yanı hergün 3 sutun ve 2 satırdan olusuyor ve gerektıgınde onralarada personel ismi yazılacak ve puantaja eklenecek ben sızın gönderdiğiniz kod uzerınde çalıştım bıraz oldu fakat benım yaptıgımı calıstırınca sadece ör:1. gunun sadece 2. satırını puantaja ekliyor sizinki de sadece 1. günün 1. satırını puantaja cevırıyor 2sını aynı anda aktaramadım.bıde bılıyom cok oldum ama listenin en sağında bır M.YSP BAŞLIKLI boş sutun var bu lısteye ısım eklemeyı unutmusum bu lıstede 8 saat olarak aktarılması gerekıyordu yıne bu m.ysp sutunuda 2 kısılık cok ugrasyım ama bunları yapamadım. yardımcı olurmusunuz bu konulardada. SİZE emegınızden dolayı cok cok tesekkur edıyorum bana yardımcı oldunuz bu mesadakılerı olmasa bıle ılk halı ıle yıne cok ısıme yaradı kod lar Allah razı olsun soznsuzn tesekkurler

6 kişilik Nöbet için şu kodları deneyin. M YSP olayını hiç anlamadım.

Sub aktar()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
deger = 8  'Nöbet saati
Sayfa2.Range("M6:AQ17").ClearContents
For x = 1 To 31
    For y = 10 To 12        'J=10, K=11, L=12 sütun
       tmp1 = Sayfa1.Cells(2 * x + 1, y)    'H3 H61 Arası 2  şer adımla ilerle
       if tmp1="" then goto atla
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
atla:     
[B][COLOR="Red"]       tmp1 = Sayfa1.Cells(2 * x + 2, y)    'H3 H61 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla2
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
atla2:
[/COLOR][/B]
    Next y
Next x
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[systran]

kodların son hali

Sub aktar()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sayfa2.Range("M6:AQ17").ClearContents
For x = 1 To 31
    For y = 10 To [B][COLOR="Red"]13[/COLOR][/B]        'J=10, K=11, L=12, M=13. sütun
 [COLOR="red"][B]      If y = 13 Then
        deger = 8
       Else
        deger = 24
       End If[/B][/COLOR]
       tmp1 = Sayfa1.Cells(2 * x + 1, y)    'H3 H61 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
atla:
       tmp1 = Sayfa1.Cells(2 * x + 2, y)    'H3 H61 Arası 2  şer adımla ilerle
       If tmp1 = "" Then GoTo atla2
       For Z = 6 To 17      'Puantaj sayfası personel sayısı 6. satır 17. satır
            tmp2 = Sayfa2.Cells(Z, "K")
            If tmp1 = tmp2 Then
                Sayfa2.Cells(Z, x + 12) = deger
                Exit For
            End If
       Next Z
atla2:

    Next y
Next x
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[attrd]

cok cok tesekkur ederım ALLAH razı olsun.

 

[systran]

amin, cümlemizden.