• DİKKAT

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

Yan sayfadan veri alma.

S

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,194
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office Professional Plus 2016
Herkese Merhabalar,

Ekli dosyada 1 aylık çalışma programı yazıyorum.
Çalışma çizelgesi sayfasına haftalık olarak çalışma çizelgesi oluşturmak için yardımlarınızı rica ederim.
Saygılarımla,
sward175
 

Ekli dosyalar

Aşağıdaki makroyu deneyiniz:

PHP: 
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Çizelgesi")

songun = s2.Cells(Rows.Count, "A").End(3).Row
sonper = s1.Cells(Rows.Count, "B").End(3).Row - 19

s2.[C6:R53].ClearContents

For gun = 6 To 48 Step 7
    ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
    var1 = 0: var2 = 0: var3 = 0: var4 = 0: var5 = 0: var6 = 0: var7 = 0
    
    sut = WorksheetFunction.Match(s2.Cells(gun, "A"), s1.[A3:AG3], 0)
    For kisi = 4 To sonper
        If s1.Cells(kisi, "B") <> "" Then
            If s1.Cells(kisi, sut) = "HT" Then
                s2.Cells(gun + ht, "J") = s1.Cells(kisi, "B")
                ht = ht + 1
            End If
            If s1.Cells(kisi, sut) = "Yİ" Then
                s2.Cells(gun + yi, "K") = s1.Cells(kisi, "B")
                yi = yi + 1
            End If
            If s1.Cells(kisi, sut) = "VD" Then
                s2.Cells(gun + vd, "L") = s1.Cells(kisi, "B")
                vd = vd + 1
            End If
            If s1.Cells(kisi, sut) = "R" Then
                s2.Cells(gun + r, "M") = s1.Cells(kisi, "B")
                r = r + 1
            End If
            If s1.Cells(kisi, sut) = "Mİ" Then
                s2.Cells(gun + mi, "N") = s1.Cells(kisi, "B")
                mi = mi + 1
            End If
            If s1.Cells(kisi, sut) = "RT" Then
                s2.Cells(gun + rt, "O") = s1.Cells(kisi, "B")
                rt = rt + 1
            End If
            If s1.Cells(kisi, sut) = "Üİ" Then
                s2.Cells(gun + ui, "P") = s1.Cells(kisi, "B")
                ui = ui + 1
            End If
            If s1.Cells(kisi, sut) = "Bİ" Then
                s2.Cells(gun + bi, "Q") = s1.Cells(kisi, "B")
                bi = bi + 1
            End If
            If s1.Cells(kisi, sut) = "Öİ" Then
                s2.Cells(gun + oi, "R") = s1.Cells(kisi, "B")
                oi = oi + 1
            End If
            
            If s1.Cells(kisi, sut) = s2.[C5] Then
                s2.Cells(gun + var1, "C") = s1.Cells(kisi, "B")
                var1 = var1 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[D5] Then
                s2.Cells(gun + var2, "D") = s1.Cells(kisi, "B")
                var2 = var2 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[E5] Then
                s2.Cells(gun + var3, "E") = s1.Cells(kisi, "B")
                var3 = var3 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[F5] Then
                s2.Cells(gun + var4, "F") = s1.Cells(kisi, "B")
                var4 = var4 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[G5] Then
                s2.Cells(gun + var5, "G") = s1.Cells(kisi, "B")
                var5 = var5 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[H5] Then
                s2.Cells(gun + var6, "H") = s1.Cells(kisi, "B")
                var6 = var6 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[I5] Then
                s2.Cells(gun + var7, "I") = s1.Cells(kisi, "B")
                var7 = var7 + 1
            End If
        End If
    Next
Next
                
End Sub
 
YUSUF44,
Çok Çok ama Çok Teşekkürler ediyorum.
Sağ olun,
sward175
 
Herkese Merhabalar,
Sayın, YUSUF44, Arkadaşımızın vermiş olduğu kodlar gayet güzel çalışıyor.
Çalışan sayısının artmasıyla formatı değiştirmem gerekti.
Bu şekli ile makroya yardım edecek arkadaşlara teşekkürlerimi sunarım.
Saygılarımla,
sward175
 

Ekli dosyalar

Aşağıdaki makroyu deneyiniz:

PHP: 
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN45").ClearContents
s2.Range("C50:AN89").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 47 Step 44
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AG3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 3) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 4) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 5) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub
 
Sayın, YUSUF44,
Teşekkürlerimi bir borç bilirim.
Sağ olun.
sward175
 
Herkese Merhabalar,
Sayın, YUSUF44, Arkadaşımızın vermiş olduğu kodlar ile çalışıyorum.
Çalışan sayısının artmasıyla formata değişiklik gerekti.
Ekteki biçimi ile makroya yardım edecek arkadaşlara teşekkürlerimi sunarım.
Saygılarımla,
sward175
 

Ekli dosyalar

Sanıyorum sorun sadece döngü aralığının değiştirilmesiyle ilgili. Bunu sizin de yapabilmeniz lazımdı aslında, biraz dikkat ve gayretle yapabilirdiniz bence.

Aşağıdaki makro uygun mu?

PHP: 
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN65").ClearContents
s2.Range("C70:AN129").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AG3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 3) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 4) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 5) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub
 
Sayın, YUSUF44.
Çok teşekkür ederim.
Makro bilgim sıfıra yakın olduğu için yardım ihtiyacı duyuyorum, Uyarınızı anladım daha fazla satırlı olursa halledeceğim galiba.
Yine de çok teşekkür ediyorum.
Sağ Olun, sward175
 
YUSUF44 Bey,
Kodu uygulayınca anladım gözümden kaçmış vardiya adedini 4 yapınca sütun kayması oldu, Bu konu hakkında yardımınızı rica edebilir miyim ?,
Saygılarımla,
sward175
 

Ekli dosyalar

Sadece o değil, ayrıca VD isimli sütununuzu da iptal etmişsiniz. Lütfen bu değişikliklere dikkat edelim, hatanın nerde olduğunu buluncaya kadar yarım saat uğraştım.

Aşağıdaki makroyu deneyiniz:

PHP: 
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN65").ClearContents
s2.Range("C70:AN129").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0: var4 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AN3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 4) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 5) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 3) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 3) = s1.Cells(kisi, "B")
                    var4 = var4 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub
 
Sayın, YUSUF44,
Çok güzel gayet iyi çalışıyor.
Her şey için çık çok teşekkür ederim.
Saygılarımla,
sward175
 
Herkese Günaydın.
Sayın, YUSUF44 Arkadaşımızın yardımı ile geliştirmeye çalıştığım vardiya sayfasından çalışma listesi sayfasına veri aktarırken makroda aşağıdaki hatayı alıyorum.
Konu hakkında yardımlarınızı rica ederim.
Saygılarımla,
sward175

sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AW3], 0)
 

Ekli dosyalar

Çalışma Listesi sayfasında Kasım ayına ait günler varken, Vardiya sayfasında Ocak ayının verileri olmasından kaynaklanıyor olabilir mi? :o
 
Merhaba, YUSUF44,
Tarihleri değiştirdim ama gene aynı hatayı listenin bir bölümünü dizerek verdi.
sward175
 

Ekli dosyalar

Farkında mısınız bilmiyorum ama bir önceki dosyanızda vardiya sayınızın artması nedeniyle kodlarda günceleme yapmıştık. Şimdi bir önceki dosyanızla şimdiki dosyanızı karşılaştırdığımda görüyorum ki yine değişiklik yapmışsınız. Bir önceki dosyanızda 4 vardiya 8 de özel durum varken şimdiki dosyanızda 6 vardiya 9 özel durum var.

Bir önceki durumda vardiya düzeni değişince oluşan hatanın farkındayken şimdi bunu farketmemiş olmanız şaşırtıcı. Kodlarda yeni eklenen sütunlara göre güncelleme yapılması gerekir. Ancak emeğimizin boşa gitmemesi adına bu dosyanın artık son hali olduğuna emin misiniz? Yarın başka vardiya ya da özel durumlar ekleyip çıkartmayacaksınız değil mi?
 
Merhaba, Sayın, YUSUF44,
Gerçekten özür dilerim ne diyeyim ki sürekli değişiklik gerektiren bir durum olduğu için sizleri meşgul ediyorum. Hal böyle olunca doğal ki istekler artıyor, Bilesiniz ki bu konuda son isteğimdir yardımınız.
İlginize teşekkür ediyorum.
saygılarımla,
sward175
 
Bazı güncellemeleri yapmışsınız ama bazıları eksik kalmış, özellikle for next döngüsünün step yani adım aralığı olmamış, bir de HT ve diğer durumlar için eklenecek sütun sayısını 1 fazla belirlemişsiniz. Onları düzelttim:

PHP: 
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AW65").ClearContents
s2.Range("C70:AW129").ClearContents

For gun1 = 3 To 35 Step 16
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0: var4 = 0: var5 = 0: var6 = 0
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AW3], 0)
        For kisi = 6 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 6) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 7) = s1.Cells(kisi, "B")
                    yi = yi + 1
                    End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 8) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 9) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 10) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 11) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 12) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 13) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 14) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 3) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 3) = s1.Cells(kisi, "B")
                    var4 = var4 + 1
                    End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 4) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 4) = s1.Cells(kisi, "B")
                    var5 = var5 + 1
                    End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 5) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 5) = s1.Cells(kisi, "B")
                    var6 = var6 + 1
                End If
            End If
        Next
    Next
Next         
End Sub
 
Sayın, YUSUF44,
Çok teşekkür ediyorum.
Elleriniz dert görmesin.
Kalın sağlıcakla
sward175
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst